vba - 遍历文件夹中的所有文件

Question

我有两个代码。我希望第二个代码对目录中的所有文件执行第一个代码。第一个代码就像一个魅力，完全符合我的需要，那就是:

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

第二个代码确实成功地遍历了我想要的所有文件夹和文档，但是它错误地执行了我的第一个代码。当我单独在工作表上执行第一个代码时，它会创建一个名为 STATS 的新工作表，然后从第一张工作表中取出 A 列中包含单词 STATS 的所有行并将它们复制到新工作表中，然后删除 STATS 行第一张纸。

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

Answer 1

保持你的第一个子，用这个替换你的第二个子:

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