打开文件夹，在Excel中操作文件，将Excel文件保存在新目录中

Question

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

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

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

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

然后，删除除"组合"以外的所有工作表

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

这就是我卡住的地方：我能够让宏正常工作，直到我添加了一个"For Loop"，该循环旨在打开数字命名的文件夹，并使用数字名称将它们保存在"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:UsersKateDesktopenron4maildir" ' 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:UsersKateDesktopenron_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

Answer 1

为什么不使用文件系统对象。
像这样：

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:UserYourdestination" '<~~ change to suit
    fldrPath = "C:UserYourfolder" '<~~ 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

我只是基于你如何描述你想要的东西。虽然没有测试。
您需要添加对脚本运行时Microsoft引用。呵呵。