Excel VBA - サブフォルダのデータを含むループVBA

Question

メインのExcelファイルとCSVデータがいくつかのサブフォルダにあります。あるサブフォルダからCSVをロードし、別のVBAスクリプトを開始してから次のサブフォルダに移動したいと考えています。

例：

• MyExcelFile.xlsm
• カントリー1
• ../Data1.csv
• ../Data2.csv
• カントリー2
• ../Data3 .csv
• ../Data4.csv

COUNTRY1 Report1.csv Report2.csv COUNTRY2 Report3.csv Report4.csv

ロードCOUNTRY1からすべてのCSV、レポートを生成し、その後、COUNTRY2に移動し、このデータとレポートを生成します。

は、ここに私のVBAは（言及者のおかげで）CSVを読み込むことです：

Sub ImportCSVs() 
'Author: Jerry Beaucaire 
'Date:  8/16/2010 
'Summary: Import all CSV files from a folder into separate sheets 
Dim fPath As String 
Dim fCSV As String 
Dim wbCSV As Workbook 
Dim wbMST As Workbook 

Set wbMST = ThisWorkbook 
fPath = (Application.ActiveWorkbook.Path & "\")     'path to  CSV files, include the final \ 
Application.ScreenUpdating = False 'speed up macro 
Application.DisplayAlerts = False 'no error messages, take default answers 
fCSV = Dir(fPath & "*.txt")   'start the CSV file listing 

    On Error Resume Next 
    Do While Len(fCSV) > 0 
     Set wbCSV = Workbooks.Open(fPath & fCSV, xlDelimited, Delimiter:=",", Format:=6, Local:=False)     'open a CSV file 
     wbMST.Sheets(ActiveSheet.Name).Delete      'delete sheet if it exists 
     ActiveSheet.Move After:=wbMST.Sheets(wbMST.Sheets.Count) 'move new sheet into Mstr 
     Columns.AutoFit    'clean up display 
     fCSV = Dir     'ready next CSV 
    Loop 

Application.ScreenUpdating = True 
Set wbCSV = Nothing 
End Sub 

は、誰もが、私は「サブフォルダ名」の上に、すべてのサブフォルダと手に行くことができるか、私を説明することができますCSVをインポートしますか？私は午後中これを探していたが、答えを見つけることができなかった。

は、オブジェクトの作成はこちら概念である

Answer 1

:-)事前にありがとうございました。私の方法は、ターゲットフォルダ（そのサブフォルダを含む）内のすべてのCSVファイルをループし、それらのCSVを新しいtempフォルダにインポートします。 次に、現在のコードを使用して、すべてのCSVをマスターシートに読み込み、名前を変更して一時フォルダを制御することができます。お役に立てれば。

Dim Fso As Object, objFolder As Object, objSubFolder As Object, tempFolder As Object 
Dim FromPath As String 
Dim FileInFolder As Object 
Dim ToPath As String 

ToPath = "V:\MasterFolder\" 
FromPath = "V:\TargetFolder\" 
Set Fso = CreateObject("Scripting.filesystemobject") 

'clean Masterfolder first 
Set tempFolder = Fso.GetFolder(ToPath) 
For Each File In tempFolder.Files 
    File.Delete 
Next File 

'loop through each subfolders 
For Each objSubFolder In objFolder.subfolders 
    For Each FileInFolder In objSubFolder.Files 
     If FileInFolder.Name Like "*DATA*" Then 'criteria 
      FileInFolder.Copy ToPath 
     End If 
    Next FileInFolder 
Next objSubFolder 

Answer 2

ありがとうございました。私はあなたが公正であるために、代わりにあなた自身の答えを、解答としてNoAppleOnHeadの返信@マークすべきだと思う

Sub RunAll() 

Dim Fso As Object, objFolder As Object, objSubFolder As Object, tempFolder 
As Object 
Dim FromPath As String 
Dim fpath As String 
Dim FileInFolder As Object 
Dim ToPath As String 
Dim temporaryFolder As String 

temporaryFolder = "Temp" 
fpath = (Application.ActiveWorkbook.Path & "\") 
FromPath = fpath 
ToPath = fpath & temporaryFolder & "\" 
Set Fso = CreateObject("Scripting.filesystemobject") 

Set objFolder = Fso.GetFolder(FromPath) 

'clean Masterfolder first 
Set tempFolder = Fso.GetFolder(ToPath) 

'loop through each subfolders 
For Each objSubFolder In objFolder.subfolders 
    For Each File In tempFolder.Files 
     File.Delete 
    Next File 

    For Each FileInFolder In objSubFolder.Files 
     If FileInFolder.Name Like "*REPORT*.txt" Then 'criteria 
      FileInFolder.Copy ToPath 
     End If 
    Next FileInFolder 

    'Check if folder is empty 
    If Dir(ToPath & "*.*") = "" Then 

    Else 
     Call ImportCSVs 
     Call ImportData 
     Call PrintPDF 
    End If 


Next objSubFolder 

Call CloseFile 

End Sub