VBAフォルダ内のファイル名一覧を取得する方法
- VBAを使用して、特定のフォルダ内のファイル名一覧を取得する方法について説明します。
- Dir関数を使用して、フォルダ内のファイルをループ処理しながら取得し、セルに一覧として表示します。
- また、特定のファイル名以外のファイルの一覧を取得する方法についても紹介します。
- ベストアンサー
VBA フォルダ内のファイル名一覧
下のようなコードですが、Dir("C:\見積\*.xls")の部分を このコードを書いてあるブックのあるフォルダの名前をもっと簡単に取得してコードにできないでしょうか。 もうひとつ付け加えたいこともあります。ファイル名一覧にする際、このブックと「XXX.xls」という名前のブック名以外の一覧にしたいのですが、これもお手上げですので、あわせてお願いします。 Sub test() Dim myFile As String Dim fl As Integer myFile = Dir("C:\見積\*.xls") fl = 9 Do While myFile <> "" fl = fl + 1 Cells(fl, 3).Value = myFile myFile = Dir() Loop End sub
- reprogress
- お礼率45% (40/87)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
ThisWorkbook.FullName、ThisWorkbook.Path、ThisWorkbook.Name 等を使って自ブックを取得出来ます。 Sub test() Dim myFile As String, fl As Long myFile = Dir(ThisWorkbook.Path & "\*.xls") fl = 9 Do While myFile <> "" If myFile <> ThisWorkbook.Name And myFile <> "XXX.xls" Then fl = fl + 1 Cells(fl, 3).Value = myFile End If myFile = Dir() Loop End Sub
関連するQ&A
- VBAのDirをつかってブックを検索した後のことについて。
VBAのDirをつかってブックを検索した後のことについて。 お世話になっております。 以下のコードでファイルを開いたものをアクティブにするにはどうすればよろしいでしょうか？ 流れ １）以下のコードでブックを開き、このブックのセルを検索、コピー ２）貼り付けブックを開いて貼り付け ３）もう一度以下のブックで開いたブックのセル検索、コピー ４）貼り付けブックに貼り付け 流れの３）でつっかかってます。 どうか宜しくお願い致します。 ///コード/// Dim myPath As String Dim myFile As String myPath = "C:\Documents and Settings\1234567\デスクトップ\棚卸" & "\" myFile = Dir(myPath & "*棚卸一覧表(1G).xls") If myFile <> "" Then Workbooks.Open Filename:=myPath & myFile Else MsgBox "ファイルは見つかりませんでした" End If
- ベストアンサー
- その他MS Office製品
- フォルダ内の特定ブックだけを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
- 締切済み
- オフィス系ソフト
- VBAでブック名の拡張子を除去してシートにコピー
VBA初心者でコード作成で困っております。 下記の通りコードを組みましたが、シート名をブック名に変更して 保存したいのですが、このコードですと拡張子までついてしまいます。 拡張子を除去するためにはどうすればよいでしょうか？ アドバイス宜しくお願い致します。 Sub test() 'シート名の変更 Dim MyPath As String Dim MyFile As String Dim Wb As Workbook MyPath = "C:\TEST\" MyFile = Dir(MyPath & "*.xlsx") Do While MyFile <> "" Set Wb = Workbooks.Open(MyPath & MyFile) ActiveSheet.Name = ActiveWorkbook.Name Application.DisplayAlerts = False Wb.Save Application.DisplayAlerts = True Wb.Close (False) MyFile = Dir() Loop End Sub
- ベストアンサー
- オフィス系ソフト
- 複数ファイルの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 宜しくお願いいたします。
- 締切済み
- SE・インフラ・Webエンジニア
- VBAにて複数フォルダのエクセルファイルからデータ抽出を行いたいのですが…
現在、下記の方法で複数のブックからデータを抽出し、 一覧表示をしています。（一覧表示をしているブックを仮にＡとします。） 今のままだと、同一フォルダ内のブックしか抽出されません。 これを、サブフォルダまで対象にするには、どうすれば良いのでしょうか？ 簡単に例をあげると、 フォルダ（1）の中にＡを入れておいて フォルダ（1）の下にあるサブフォルダ（1）、サブフォルダ（2）の中にあるブックからデータの抽出を行いたいのです。 現在つかっているVBAは Sub 抽出用() Dim FName As String Dim Folder As String Dim wb As Workbook Dim i As Integer, j As Integer Application.ScreenUpdating = False Folder = ThisWorkbook.Path & "\" i = 1: j = 1 Worksheets(1).Cells.ClearContents FName = Dir(Folder & "*.xls") Do While FName <> "" If FName <> ThisWorkbook.Name Then Workbooks.Open (Folder & FName) Workbooks(Workbooks.Count).Worksheets(5).Rows("1:1").Copy _ ThisWorkbook.Worksheets(5).Cells(i + 3, 1) Workbooks(Workbooks.Count).Close Application.StatusBar = j & "ファイル処理済み" i = i + 1: j = j + 1 End If FName = Dir() Loop Application.StatusBar = "" Application.ScreenUpdating = True MsgBox ("完了しました") End Sub です。 いいお知恵があれば、よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
- エクセルVBAでConsolidate
以下は、ネット検索で見つけたサンプルコードです。 同じフォルダ内の全ブックのSheet１のA1:B10をThisWorkbookのSheet１に統合しています。 Sub test2() Dim MyFile As String, MyPath As String Dim SumFile() As Variant, i As Long MyPath = ThisWorkbook.Path & "\" MyFile = Dir(MyPath, vbNormal) Do Until MyFile = "" If MyFile <> ThisWorkbook.Name Then ReDim Preserve SumFile(i) 'A1からB10の値を変数に代入 SumFile(i) = "'" & MyPath & "[" & MyFile & "]Sheet1'!R1C1:R10C2" i = i + 1 End If MyFile = Dir Loop If i = 0 Then MsgBox "データが有りません": Exit Sub Worksheets("Sheet1").Range("A1").Consolidate Sources:=SumFile() End Sub 質問１ Sheet1だけでなく全シートのA1:B10をThisWorkbookのSheet１に統合するためにはどう書き換えればよいのでしょうか？ 質問２ 上記コードではなぜ、ブックを開かずにデータがとれるのでしょうか？
- ベストアンサー
- オフィス系ソフト
- Excel 2010 VBA:ファイル名を読み込む
下は複数のcsvファイルを一つに合体するVBAです。これにシートの右端に読み取ったファイル名を追加するにはどうしたらよいでしょうか。 よろしくお願いします。 Sub macro1() Dim myPath As String Dim myFile As String Dim s As String myPath = ThisWorkbook.Path & "\" On Error Resume Next Kill myPath & "合体版.csv" On Error GoTo 0 myFile = Dir(myPath & "*.csv") If myFile = "" Then Exit Sub Open myPath & "合体版.csv" For Output As #1 Do Until myFile = "" Open myPath & myFile For Input As #2 Do Until EOF(2) Line Input #2, s Print #1, s Loop Close #2 myFile = Dir() Loop Close #1 End Sub
- ベストアンサー
- Excel（エクセル）
- VBA フォルダ内にあるブックをすべて開く
いつもお世話になります。 デスクトップ上にフォルダ「新しいフォルダ」があり、その中に６つエクセルブックがあります。 Book1.xls Book2.xls Book3.xls Book4.xls Book5.xls と test.xls です。 test.xlsに、Book1～Book5を開く というマクロを作り実行したところ、実行時エラー1004 『Book1.xlsがみつかりません』と表示されます。 Sub test() Dim buf As String, i As Long buf = Dir("C:\Documents and Settings\tsasaki\デスクトップ\新しいフォルダ\*.xls") Do While buf <> "" i = i + 1 Workbooks.Open Filename:=buf 'Cells(i, 1) = buf buf = Dir() Loop End Sub どのが間違っているか教えてもらえますか。
- ベストアンサー
- オフィス系ソフト
- フォルダのファイル数をｖｂａで取得したい
vbaなのですが、フォルダにgifファイルがたくさんはいっていますが、 その数を数えるコードを教えてください。 今は、 Sub Macro7() Dim File As String Dim i As Long File = Dir("C:\*.*", vbDirectory) Do While File <> "" File = Dir i = i + 1 Loop MsgBox "ファイル数は" & i & "です" End Sub のように、全てのファイル数をカウントして求めています。
- ベストアンサー
- Visual Basic
- マクロ処理後のファイル名変更について
マクロでいくつかの処理を行った後、もとのファイル名に 「済＋ファイル名」としてファイル名を変更して終了をしたいのですが、 どのようにすればできるのかわかりません。 どなたか教えていただけますか？ イメージ） 処理前のファイル名：サラダ.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
- ベストアンサー
- オフィス系ソフト
お礼
papayukaさんこんばんは。うまくいきました。このように記述するのですね。ありがとうございました。