VBA

指定したフォルダのファイル名をシートに書き出す

こんにちは、エクセル救急隊です。

ノンプログラマーですが、お仕事効率化のためにVBAでツールを作っています。
コードを覚えるのは大変なので、すぐに使えるようコピペ用コードを用意しました。

指定シートに指定フォルダのファイル名を書き出す

書き出すシート条件

  1. セルB1にフォルダのパスを貼り付け
  2. セルB4からファイル名を書き出し
  3. シート名は「マクロ実行」

コード

Option Explicit
Sub ファイル名取得()
'-----------------------------------------------------------------------------------------------------------------------
'作成者:
'作成日時://()
'作成目的:
'-----------------------------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------------------------------
'◇変数エリア(変数宣言は全てここに記入する)
'-----------------------------------------------------------------------------------------------------------------------
    Dim i As Integer
    Dim buf As String
    Dim path As String 'フォルダのパス
'-----------------------------------------------------------------------------------------------------------------------
'◇実行プログラム
'-----------------------------------------------------------------------------------------------------------------------
    '画面のチラツキをなくしマクロの処理速度を向上
    Application.ScreenUpdating = False
    
    '前回データクリア(B4~B列最終行+1までクリア)
    ThisWorkbook.Worksheets("マクロ実行").Activate
    Range(Cells(4, 2), Cells(Cells(Rows.Count, 2).End(xlUp).Row + 1, 2)).ClearContents
    
    'フォルダのパス
    path = ThisWorkbook.Worksheets("マクロ実行").Range("B1").Value & "\"
    
    'ドットが含まれるファイル名をアクティブシートに書き出す
    buf = Dir(path & "*.*")
        i = 3
        Do While buf <> ""
            i = i + 1
            Cells(i, 2) = buf
            buf = Dir()
        Loop
    
    '既定
    Application.ScreenUpdating = True
    Application.Goto Reference:=Range("A1"), Scroll:=True
    
End Sub

 

補足

ドットがつくものをすべて書き出しましたが、エクセルだけにしたい場合は、
下記のように変更してください。

buf = Dir(path & "*.xls*")

 

おわりに

なにかのお役に立ちましたら幸いです。
以上、最後までお読みいただきありがとうございます。