循环浏览文件夹中的所有文件

我有一个两个代码。 我想第二个代码在目录中的所有文件上执行第一个代码。 第一个代码就像一个魅力，正是我所需要的，这就是：

Sub STATTRANSFER() ' Transfers all STATS lines Application.ScreenUpdating = False Worksheets.Add After:=Worksheets(Worksheets.Count) Worksheets(Worksheets.Count).Name = "STATS" Set f = Sheets(1) Set e = Sheets("Stats") Dim d Dim j Dim k d = 1 j = 1 k = 1 Do Until IsEmpty(f.Range("A" & j)) If f.Range("A" & j) = "STATS" Then e.Rows(d).Value = f.Rows(j).Value d = d + 1 f.Rows(j).Delete Else j = j + 1 End If Loop Application.ScreenUpdating = True End Sub 

第二个代码如下所示：

  Public Sub DataProcess() Dim folderPath Dim filename Dim newfilename Dim SavePath Dim mySubFolder As Object Dim mainFolder As Object Dim WB As Workbook Dim OrigWB As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet Dim name1 As String Dim name2 As String Set OrigWB = ThisWorkbook Set objFSO = CreateObject("Scripting.FileSystemObject") folderPath = ActiveWorkbook.Path Set mainFolder = objFSO.GetFolder(folderPath) filename = Dir(folderPath & "*.csv") Do While Len(filename) > 0 Set WB = Workbooks.Open(folderPath & filename) Call STATTRANSFER ActiveWorkbook.Close SaveChanges:=True filename = Dir Loop For Each mySubFolder In mainFolder.SubFolders filename = Dir(mySubFolder.Path & "\*.csv*") Do While Len(filename) > 0 Set WB = Workbooks.Open(mySubFolder.Path & "\" & filename) Call STATTRANSFER ActiveWorkbook.Close SaveChanges:=True filename = Dir Loop Next End Sub 

第二个代码成功地循环遍历我想要的所有文件夹和文档，但它不正确地执行我的第一个代码。 当我单独在工作表上执行第一个代码时，它会创build一个名为STATS的新工作表，然后从第一个工作表中的第一个工作表中的所有行开始，将A列中的单词STATS复制到新工作表中，然后删除STATS行第一张。

当我用通过所有文件夹的第二个代码运行它时，它不能工作。 我可以看到它在我的屏幕上创build了一个名为STATS的表格，但是当它完成时，我打开文档中所有在列A中具有STATS的行都在第一个表格上，STATS表格不再存在，并且所有列A中没有STATS的数据消失了。 所以我不确定是什么问题。

Answer 1

保持你的第一个子，因为它是用这个replace你的第二个子：

 Sub MM() Dim file As Variant Dim files As Variant Dim WB As Excel.Workbook files = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & ActiveWorkbook.Path & "\*.csv"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".") For Each file In files Set WB = Workbooks.Open(file) STATTRANSFER WB.Close True Set WB = Nothing Next End Sub 

Answer 2

只是作为一个评论：你的代码只运行通过第一级的子文件夹。 如果你想通过所有的子级文件夹，你必须使用recursion的方法，如：

 Private Sub test() readFileSystem ("C:\Temp\") End Sub Private Sub readFileSystem(ByVal pFolder As String) Dim oFSO As Object Dim oFolder As Object ' create FSO Set oFSO = CreateObject("Scripting.FileSystemObject") ' get start folder Set oFolder = oFSO.getFolder(pFolder) ' list folder content listFolderContent oFolder ' destroy FSO Set oFolder = Nothing Set oFSO = Nothing End Sub Private Sub listFolderContent(ByVal pFolder As Object) Dim oFile As Object Dim oFolder As Object ' go thru all sub folders For Each oFolder In pFolder.SubFolders Debug.Print oFolder.Path ' do the recursion to list sub folder content listFolderContent oFolder Next ' list all files in that directory For Each oFile In pFolder.Files Debug.Print oFile.Path Next ' destroy all objects Set pFolder = Nothing Set oFile = Nothing Set oFolder = Nothing End Sub 

这只是一个例子，你必须打电话给你的第一个程序当然仍然是正确的。 所以我会build议在第一个过程中可以传递工作簿的参数。

和顺便说一句：总是用数据types去改变你的variables。 Dim j将会声明一个VARIANTvariables，而不是你想要的一个Interger。

Answer 3

您可以在第一个表格中看到所有的STATS，因为您已经为CSV文件添加了一个额外的表单并将其保存。 根据定义，CSV文件只保存并显示1张。 对代码的这种修改可以解决您的问题，因为它调用自己去通过子文件夹。 尝试一下。 包括你的STATTRANSFER子。

 Public Sub DataProcess() thisPath = ThisWorkbook.Path process_folders (thisPath) End Sub Sub process_folders(thisPath) Dim folderPath Dim filename Dim newfilename Dim SavePath Dim mySubFolder As Object Dim mainFolder As Object Dim WB As Workbook Dim OrigWB As Workbook Dim ws1 As Worksheet Dim ws2 As Worksheet Dim name1 As String Dim name2 As String Set OrigWB = ThisWorkbook Set objFSO = CreateObject("Scripting.FileSystemObject") folderPath = ActiveWorkbook.Path Set mainFolder = objFSO.GetFolder(folderPath) folderPath = ActiveWorkbook.Path filename = Dir(folderPath & "\*.csv") Do While Len(filename) > 0 Set WB = Workbooks.Open(folderPath & "\" & filename) Call STATTRANSFER 'save file as Excel file !!! ActiveWorkbook.SaveAs _ filename:=(folderPath & "\" & filename), _ FileFormat:=xlOpenXMLWorkbook, _ CreateBackup:=False ActiveWorkbook.Close (False) filename = Dir Loop 'now with each subfolder For Each subfolder In mainFolder.SubFolders process_folders (subfolder) Next End Sub 

Answer 4

问题是你只能用一张表格保存一个.csv文件。 现在代码看起来像这样。

 Sub NewDataProcess() Dim file As Variant Dim files As Variant Dim wb As Excel.Workbook files = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & ActiveWorkbook.Path & "\*.csv"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".") For Each file In files Set wb = Workbooks.Open(file) Call STATTRANSFER(wb) newfilename = Replace(file, ".csv", ".xlsm") wb.SaveAs filename:=newfilename, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False wb.Close SaveChanges:=False Set wb = Nothing Next End Sub 

现在我需要一种方法来删除旧文件，如果有人可以帮助。 我不再需要CSV文件了