• ベストアンサー

複数のファイルに対し同じ処理を行う方法

複数のファイルのエクセルファイルに対し、同じ処理を行うマクロを教えてほしいです。 処理するファイル数が一定でないため、現在はDo While~Loop構文を用い強引に処理しています。 しかし、この方法では処理が終わる(アクティブファイルが無くなる)とエラーメッセージが出るため、煩わしいです。 Do Until構文で、終了条件を指定したらよさそうなのですが、どのように書けばいいのかわかりません。 現在記述しているものは以下です。 -------------------------------------------------------- Sub 連続処理() Dim BookName As String Dim PathName As String PathName = "D:\A1\連続処理\" BookName = Dir(PathName & "*.xls")   Do Until BookName = ""  Workbooks.Open PathName & BookName  BookName = Dir() Loop Do While (1)   ・   ・(処理作業を行うマクロ)   ・ Workbooks(ActiveWorkbook.Name).Close savechanges:=True Loop End Sub

  • shimP
  • お礼率75% (89/118)

質問者が選んだベストアンサー

  • ベストアンサー
  • imogasi
  • ベストアンサー率27% (4737/17068)
回答No.2

この質問にはどの範囲のフォルダなどのファイルを対象にするのか書かないと、1つのフォルダなら Sub Test01() Dim BookName As String Dim PathName As String PathName = "C:\Documents and Settings\XXX\My Documents\" BookName = Dir(PathName & "*.xls") Do Until BookName = "" (BookNameブックオープン) ( 処理) BookName = Dir() Loop (もしあれば終わり処理) End Sub でよいのでは。 ーー Do While (1)   ・   ・(処理作業を行うマクロ)   ・ Workbooks(ActiveWorkbook.Name).Close savechanges:=True Loop は不要ではないのかな。

shimP
質問者

お礼

ありがとうございます。 ある特定のフォルダに納めたファイル全ての処理を行いたかったんです。 提示された式で無事走りおえました。 中に入れ込めばよかったのですね。

その他の回答 (2)

  • n-jun
  • ベストアンサー率33% (959/2873)
回答No.3

Sub try()  Dim Fname As String  Fname = Dir("R:\*.xls")  Do Until Fname = ""    Workbooks.Open "R:\" & Fname    '何かの処理    Debug.Print Fname    Workbooks(Fname).Close True    Fname = Dir()  Loop End Sub と言う感じの事とは違いますか?

shimP
質問者

お礼

ありがとうございます。 No.2の方と同じやり方ですよね。 Debug.Print Fnameというのは、データ保存する前に、念のためファイル名を返して置くという認識でいいのでしょうか。

  • yyr446
  • ベストアンサー率65% (870/1330)
回答No.1

FileSystemObjectというのを使ってみてはどうですか。 Dim FSO As New FileSystemObject Dim folder As Folder Dim file As File Dim PathName As string PathName = "D:\A1\連続処理\" Set folder = FSO.GetFolder(PathName) For Each file In folder 'ファイルの処理 Workbooks.Open(file.name) ..... Next file

shimP
質問者

お礼

ありがとうございます。 今回はNo.2の方の方法で解決することができました。 ですが、貴方が提示されたFSOオブジェクトを利用すると、視覚的に非常にわかりやすいですね。 次回、同じようなケースがありましたら、利用したいと思います。

関連するQ&A

  • 指定フォルダ内のファイルオープン→別フォルダに同じファイル名のcsvとして保存 のマクロを作ろうとしています

    エクセルで、指定フォルダ内のファイルオープン→別フォルダに同じファイル名のcsvとして保存 のマクロを作ろうとしています。 現在下記のようなマクロを途中まで作成したのですが、保存の良い方法が分からず困っております。 (ファイルオープンまでは出来ているようですが、その後エラーが出てしまいます) どなたかお知恵を拝借願えませんでしょうか。 どうぞ宜しくお願い致します。 Sub Book_Open() Dim BookName As String Dim PathName As String PathName = "C:\test_htmltocsv\test\" BookName = Dir(PathName & "*.html") Do Until BookName = "" Workbooks.Open PathName & BookName BookName = Dir() ActiveWorkbook.SaveAs "Sample.xls" ←← Loop End Sub

  • VBA フォルダ内のファイルを昇順に読み出す方法

    以下のような簡単なプログラムを組みました。 ファイル名を昇順に読み出せると思っていましたが、そうならない場合があるようです。 なぜなのでしょうか? また、どうすればファイルを昇順に読み出せるのでしょうか? どなたか教えて頂けないでしょうか? (抜粋) Set WS1 = Worksheets("データー(org)") '書き出すシート Set WS3 = Worksheets("集計") Dim a As String With Application.FileDialog(msoFileDialogFolderPicker) .Show PathName = .SelectedItems(1) & "\" 'ファイルの入っているフォルダを指定 End With BookName = Dir(PathName) '処理するファイル Do Until BookName = "" Workbooks.Open PathName & BookName 'ファイルを開く Set WS2 = Worksheets(1) '読み込むシート WS2.Rows("1:" & WS2.UsedRange.Rows.Count).Copy If WS1.UsedRange.Rows.Count = 1 Then WS1.Rows(WS1.UsedRange.Rows.Count).PasteSpecial Paste:=xlValues Else WS1.Rows(WS1.UsedRange.Rows.Count + 1).PasteSpecial Paste:=xlValues End If Workbooks(BookName).Close 'ファイルを閉じる BookName = Dir() 'ファイル名をクリア Loop

  • エクセルVBA:テキストデータ(txt)の読込(改行が変なところでされる)

    勉強しながら、エクセルVBAを組んでみたのですが うまくいきません。 テキストデータを以下のようなプログラムで読んだのですが (100行のデータを縦に並ぶように100個のセルの書き出す) 読み込みデータに「↓」で改行されているところでは 「↓」の間は同一行と見なされてしまうのですが どのようにしたら一行で一つのデータと見てくれるのでしょうか? 分かる方がいましたら教えて下さい。 よろしくお願いします。 Sub pon() '*** 変数の宣言 *** Dim filenum As String Dim i As Integer Dim num As Integer, ms As String, cnt As Integer Dim BookName As String, PathName As String Dim ca As String cnt = 1 i = 1 ca = Cells(1, 56) PathName = "C:\" textpath = Dir(PathName & "pon" & ca & ".txt") BookName = Dir(PathName & "pon" & ca & ".txt") Open PathName & BookName For Input As #1 'ファイルを開きます Do While Not EOF(1) Line Input #1, ms cnt = cnt + 1 Cells(1, 57) = BookName 'データの書き出し Cells(cnt, 56) = ms 'データの書き出し Loop Close #1 End Sub

  • すべてのファイルにデータを取得方法

    VBAで一覧作成を作っているですけど、ちょっと力不足のせいで、わからないところがあって、ぜひご教示ください。 フォルダにあるすべてのファイルを読み込んで、中の値を取得したいです。いろいろ方法を試して見たのですが、うまく行かないです。 こんな感じです。(一覧作成見たいもの) xlsファイル1   A  B   C     D 1 氏名 NO オーダー名  時間 に 指定されたフォルダ中のすべてファイル A   B     C (一つのファイル) 1 氏名   山田  2 No オーダー名  時間 3 01    A 1 4 02  B 1 5 03  B  1 氏名   佐藤  (二つのファイル) No オーダー名  時間 03  C 1 04  D 1 05    E 1 ・ ・ ・ の最後のファイルまでを 読み込んだら xlsファイル1を  A  B   C     D 氏名 NO オーダー名  時間 山田 01 A 1 山田 02 B 2 佐藤 03 C 1 佐藤 04 D 1 佐藤 05   E      1 ・ ・ ・ こんな感じ Dim BookName As String Dim PathName As String Dim WS1 As Worksheet Dim WS2 As Worksheet Dim no2_count As Long ’xlsファイル1 Set WS1 = Worksheets("個人一覧作成") no2_count = WS1.Cells(Rows.count, 1).End(xlUp).Row Dim i As Integer For i = 2 To no2_count Step 1 PathName = "C:\test\" BookName = Dir(PathName & "*.xls", vbNormal) Do Until BookName = "" Workbooks.Open PathName & BookName Set WS2 = Worksheets(2)   ’氏名の値を取得 WS1.Range("A" & i).Value = WS2.Cells("B,C", 2).Value Workbooks(BookName).Close    BookName = Dir() Loop Next i 初心者なので今の段階では氏名の値すら取得できないですけど、 簡単でも結構ですので、どなたは方法をご教示ください。

  • 複数ファイルのA1だけを抽出して別ファイルにしたい

    すみませんが、教えてください。 特定のフォルダ内に入っているcsvのA1列目のみ抽出して別ファイルにしたく、検索したところ 同じように困っていた方がいたようで、参考にさせていただいたのですが、 以下を実行しても インデックスが有効範囲にありませんと出ます。 各csvファイルのシート名は 1000近くあるファイル全て違い、別々の名前(コード00-000とか)になっています。 (エクセルで開いたとき) お手数ですが、教えていただきたくお願いいたします。 参考にしたマクロです。 Sub macro1() Dim myPath As String Dim myFile As String myPath = "ファイルの場所\" myFile = Dir(myPath & "*.xls") Do Until myFile = "" Workbooks.Open myPath & myFile With Workbooks("集約.xls").Worksheets("Sheet1").Range("A65536").End(xlUp) .Offset(1, 0).Value = myFile .Offset(1, 1).Value = Workbooks(myFile).Worksheets("概要").Range("C3").Value End With Workbooks(myFile).Close savechanges:=False myFile = Dir() Loop End Sub 宜しくお願いいたします。

  • マクロ処理後のファイル名変更について

    マクロでいくつかの処理を行った後、もとのファイル名に 「済+ファイル名」としてファイル名を変更して終了をしたいのですが、 どのようにすればできるのかわかりません。 どなたか教えていただけますか? イメージ) 処理前のファイル名:サラダ.xls、お肉.xls・・・ 処理後のファイル名:済サラダ.xls、済お肉.xls・・・ Dim myPath As String Dim myFile As String Dim w As Workbook Dim s As Worksheet myPath = ThisWorkbook.Path & "\" myFile = Dir(myPath & "*.xls") Do Until myFile = "" If myFile <> ThisWorkbook.Name Then Set w = Workbooks.Open(myPath & myFile) For Each s In w.Worksheets s.Range・・・・・     ・・・・・・・・     ・・・・・・・・ Next w.Close savechanges:=True End If myFile = Dir() Loop MsgBox "完了しました。" End Sub

  • 複数フォルダにある複数ファイルの一括印刷

    下記の通りフォルダの中にある、複数のエクセルファイルを印刷するマクロを使用しています (どこからか、参考にして自分なりに変更したら、出来たのですが・・・) 一つのフォルダに存在する複数フォルダの複数ファイルを、上記同様に印刷する方法は どのようにすればよいのでしょうか?(フォルダは30個位、ファイル1~20個位、増減あり) どなたか、お知恵をお貸しください。お願いいたします。 Sub test() ' ' 印刷マクロ ' Dim fol As String Dim f As String Dim wb As Workbook Dim wscnt As Long Dim i As Long fol = "d:\sampul" f = Dir(fol & "\*.xls") Do While f <> "" Set wb = Workbooks.Open(fol & "\" & f) wscnt = wb.Worksheets.Count For i = 1 To 1 wb.Worksheets(i).PrintOut Next i wb.Close f = Dir() Loop Set wb = Nothing End Sub

  • Excelのマクロで同じ処理を実行

    Excelのマクロについてです。 この度、フォルダ内にあるデータから傾きを抽出して、 データシートにまとめる作業を求められています。 一度ずつ開いて行うのが大変なので、マクロを用いようと思っています。 Sub マクロループ() Dim myPath As String Dim myFile As String myPath = "C:\test\" myFile = Dir(myPath & "*.CSV*") Do Until myFile = "" Workbooks.Open myPath & myFile ( ActiveWindow.ScrollRow = 2 ActiveWindow.ScrollRow = 3 ~ ~ ActiveSheet.Shapes("グラフ 1").IncrementLeft -125.25 ActiveSheet.Shapes("グラフ 1").IncrementTop 21.75 Application.CommandBars("Format Object").Visible = False ) ActiveWorkbook.Close True myFile = Dir() Loop End Sub ~の部分に省略した処理が入ります。 これでエラーなどは起きないのですが、開いて閉じるだけになってしまっています。 ()で括られた部分だけで実行すると、そのファイルで傾きを表示してくれます。 これを全ファイルでやりたいのですが、お力添えをお願いします。 また、それぞれで得られた傾きをデータシートに自動で入力することなどができればそれも教えていただければ幸いです。 どうかよろしくお願いします。

  • フォルダ内の特定ブックだけを1つのブックにまとめる

    以前こちらで質問させて頂きましたフォルダ内の特定ブックだけを1にのブックにまとめる方法で、大変助かっていましたがブック名が変更になり、教えて頂いたマクロでは実行できなくなったので自分なりに考えたのですがどうしてもできません。 質問時のブック名は「1_****」と「2_****」で 今回「1_****」だけが「1(3)_****」に変更になりました。 下記のマクロでmyfile = dir(mypath & "1_" & "*.xl*")→myfile = dir(mypath & "1(3)_" & "*.xl*")に変更するのはわかるのですが do until myfile = ""   myfile2 = "2" & mid(myfile,2,99)をどう変更すれば良いかわかりません どなたかお助け頂けませんか? sub macro1()  dim myPath as string  dim myFile as string  dim myFile2 as string  mypath = "c:\test\"  myfile = dir(mypath & "1_" & "*.xl*")  do until myfile = ""   myfile2 = "2" & mid(myfile,2,99)   workbooks.open mypath & myfile   workbooks.open mypath & myfile2   application.displayalerts = false   workbooks(myfile).worksheets("2").delete   application.displayalerts = true   workbooks(myfile2).worksheets("2").move after:=workbooks(myfile).worksheets("1")   workbooks(myfile).close true   workbooks(myfile2).close false   myfile = dir()  loop end sub

  • File = Dir は何をしてるのでしょう?

    vbaです。 ---------------------------- Sub フォルダの中にあるファイルとフォルダを書き出す() Dim File As String File = Dir("C:\*.*", vbDirectory) Do While File <> "" Debug.Print File File = Dir Loop End Sub ---------------------------- このコードを実行すると、 フォルダの中にあるファイルとフォルダを書き出されるのですが File = Dir のコードは何をしているのでしょうか? 引数なしのDirの使い方もよくわからないし File = Dirがある事によってどういう効果があるのかもわかりません。

専門家に質問してみよう