Vba 打开文件夹，在excel中操作文件，在新目录中保存excel文件

我有一个名为“maildir”的文件夹。它包含以数字命名的文件夹。这些文件夹包含文本文件

我拼凑了一个宏，它可以打开以数字命名的文件夹，打开它的第一个文本文件，并将内容复制到Excel中。然后打开目录中的下一个文件，并将新文件复制到同一工作簿中的新工作表中

然后，对于工作簿中的每个工作表，该过程将删除第五行下面的所有行

下一步将所有工作表中的内容合并到一个名为“合并”的新工作表中

然后，删除除“合并”之外的所有图纸

下一步将工作簿保存到名为“enron_excel”的新文件夹中

这就是我被卡住的地方：我能够让宏正常工作，直到我添加了一个“For循环”，该循环旨在打开以数字命名的文件夹，并将它们以数字名称保存在“enron_excel”文件夹中

但当我运行代码并查看“enron_excel”文件夹时，似乎错过了“组合”步骤。有人知道发生了什么吗

多谢各位

Sub all()

Application.DisplayAlerts = False
Dim J As Integer
Dim ws As Worksheet
Dim wks As Worksheet

For i = 1 To 3 ' What I want this for loop to do: open the file called "1" (and later 2 and 3), manipulate the data then save with the same number in a different file


Path = "C:\Users\Kate\Desktop\enron4\maildir\" ' open folder in a directory
Filename = Dir(Path & i & "*.txt") ' opens a folder, and a text file in that folder
Do While Filename <> "" ' opens file in folder and copies to sheet in excel workbook
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
    Sheet.Copy After:=ThisWorkbook.Sheets(1)
    Next Sheet
    Workbooks(Filename).Close
    Filename = Dir()
    Loop


    For Each ws In ThisWorkbook.Worksheets ' deletes all the rows below row five
    ws.Range("5:1000").Delete
    Next ws

On Error Resume Next
Sheets(1).Select ' combines all the sheets into one worksheet
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
    For J = 2 To Sheets.Count
    Sheets(J).Activate
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
    Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next J



    Sheets("Combined").Select '  selects the sheet calls "Combined" and deletes all the others
    Application.DisplayAlerts = False
    For Each wks In Worksheets
        If wks.Name <> ActiveSheet.Name Then wks.Delete
    Next wks


Path = "C:\Users\Kate\Desktop\enron_excel\" ' this opens a new path
FolderName = i
ActiveWorkbook.SaveAs Filename:=Path & FolderName ' this saves the file in the new path with the new name
  Application.DisplayAlerts = True
Next i
End Sub

Sub all（）
Application.DisplayAlerts=False
作为整数的Dim J
将ws设置为工作表
将工作作为工作表
对于i=1到3'我想让这个For循环做什么：打开名为“1”的文件（以及后面的2和3），操作数据，然后用相同的数字保存在不同的文件中
Path=“C:\Users\Kate\Desktop\enron4\maildir\”打开目录中的文件夹
Filename=Dir（Path&i&“*.txt”）'打开一个文件夹，并在该文件夹中打开一个文本文件
文件名“”打开文件夹中的文件并复制到excel工作簿中的工作表时执行此操作
工作簿。打开文件名：=路径和文件名，只读：=真
对于ActiveWorkbook.Sheets中的每个工作表
Sheet.Copy After:=此工作簿.Sheets（1）
下一页
工作簿（文件名）。关闭
Filename=Dir（）
环
对于此工作簿中的每个ws。工作表删除第五行下面的所有行
ws.范围（“5:1000”）。删除
下一个ws
出错时继续下一步
工作表（1）。选择“将所有工作表合并到一个工作表中”
工作表。添加
第（1）页。Name=“组合”
第（2）页。激活
范围（“A1”）.EntireRow.Select
选择。复制目的地：=图纸（1）。范围（“A1”）
对于J=2至张数。计数
第（J）页。激活
范围（“A1”）。选择
Selection.CurrentRegion.Select
Selection.Offset（1，0）。调整大小（Selection.Rows.Count-1）。选择
选择。复制目的地：=页（1）。范围（“A65536”）。结束（xlUp）（2）
下一个J
工作表（“组合”）。选择该工作表将调用“组合”并删除所有其他工作表
Application.DisplayAlerts=False
对于工作表中的每项工作
如果wks.Name ActiveSheet.Name，则wks.Delete
接下来的工作
Path=“C:\Users\Kate\Desktop\enron\u excel\”这将打开一个新路径
FolderName=i
ActiveWorkbook.SaveAs Filename:=Path&FolderName'这将使用新名称将文件保存在新路径中
Application.DisplayAlerts=True
接下来我
端接头

为什么不使用文件系统对象。
比如：

Sub ReadAllfiles()
    Dim fso As Scripting.FileSystemObject
    Dim sFile As Scripting.File
    Dim subFldr As Scripting.Folder
    Dim wbName As String
    Dim fldrPath As String
    Dim fname As String
    Dim fldrDesc As String
    Dim wbTxt As Workbook
    Dim ws As Worksheet
    Dim wbDesc As Workbook
    fldrDesc = "C:\User\Yourdestination\" '<~~ change to suit
    fldrPath = "C:\User\Yourfolder" '<~~ change to suit
    'iterate each folder of your source folder
    Set fso = New Scripting.FileSystemObject
    For Each subFldr In fso.GetFolder(fldrpath).SubFolders
        wbName = subFldr.Name
        Set wbDesc = Workbooks.Add 'add a new workbook
        'create the combined sheet
        Set ws = wbDesc.Sheets(1): ws.Name = "Combined"
        'iterate each file on the folder
        For Each sFile In subFldr.Files
            fname = sFile.ParentFolder.Path & "\" & sFile.Name
            Set wbTxt = Workbooks.Open(fname)
            'I'm not sure why a text file will yield to multiple sheet
            'so if that is really the case use your loop
            'copy the 1st 4 rows to Combined sheet
            wbTxt.Sheets(1).Range("1:4").Copy _
                ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0)
            wbTxt.Close False 'close source text file
        Next
        wbDesc.SaveAs fldrDesc & wbName 'save the workbook
        wbDesc.Close True 'close
    Next
End Sub

Sub ReadAllfiles（）
将fso设置为Scripting.FileSystemObject
将sFile设置为Scripting.File
将subFldr作为脚本。文件夹
将wbName设置为字符串
将fldrPath设置为字符串
作为字符串的Dim fname
作为字符串的Dim fldrDesc
将wbTxt设置为工作簿
将ws设置为工作表
将wbDesc设置为工作簿
fldrDesc=“C:\User\Yourdestination\”'我收到错误“未设置对象变量或带块变量”。我添加了对microsoft脚本运行时的引用。@user3411757调试时哪一行突出显示？@user3411757我无法设置
fso
，这就是它出错的原因。我添加了它，所以请尝试：）我也尝试和测试了它，它的工作。