0

重複の可能性：
vbaでサブディレクトリのリストを取得

次のコードを適用しようとしています。これは、フォルダー内のすべてのファイルに対してこの VBA ループを実行することに適用され、1 つのフォルダー内のすべてのフォルダーに対して実行されます。

これが可能な方法はありますか？

約 50 個のフォルダーがあり、それぞれに同じ名前のワークブックが含まれているため、より効率的にする必要があります。

ありがとう！

Sub LoopFiles()

    Application.DisplayAlerts = False    
    Dim strDir As String, strFileName As String
    Dim wbCopyBook As Workbook
    Dim wbNewBook As Workbook

    strDir = "C:\Documents and Settings\mburke\Desktop\Occupancy 2013\"
    strFileName = Dir(strDir & "*.xlsm")

    Set wbNewBook = Workbooks.Add

    Do While strFileName <> ""
        Set wbCopyBook = Workbooks.Open(strDir & strFileName)
        wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
        wbCopyBook.Close False
        strFileName = Dir
    Loop

    Application.DisplayAlerts = True
End Sub
4

1 に答える 1

1

できますよ！フォルダーの DIR を実行する別の LoopDirectories メソッドを追加するだけです。

ディレクトリ パラメータを受け入れるように LoopF​​iles メソッドを変更します。

Sub LoopFiles(directory As String)

    Application.DisplayAlerts = False

    Dim strDir As String, strFileName As String
    Dim wbCopyBook As Workbook
    Dim wbNewBook As Workbook


    strFileName = Dir(directory & "*.xlsm")

    Set wbNewBook = Workbooks.Add

    Do While strFileName <> ""
        Set wbCopyBook = Workbooks.Open(directory & strFileName)
        wbCopyBook.Sheets(1).Copy Before:=wbNewBook.Sheets(1)
        wbCopyBook.Close False
        strFileName = Dir
    Loop

    Application.DisplayAlerts = True
End Sub

次に、LoopDirecotries メソッドで各フォルダーに対して LoopF​​iles メソッドを呼び出します。

于 2012-10-21T21:52:23.397 に答える