Excel VBA – 使用子文件夹中的数据循环使用VBA
我有一个主要的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 任何人都可以解释我，我怎么可以去所有的子文件夹，并交出ImportCSVs CSV的“子文件夹名称”？ 我整个下午都在找这个，但是找不到答案。
非常感谢你提前:-)
创build对象是这里的概念。 我的方式是遍历目标文件夹（包括其子文件夹）中的所有CSV文件，然后将这些CSV符合我的标准导入到一个新的临时文件夹中。 然后你可以使用你当前的代码加载所有的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
非常感谢你的帮助。 我设法做到了我想要的以下代码：
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