Question

我有一个名为＆＃34; maildir＆＃34;的文件夹。它包含以数字命名的文件夹。这些文件夹包含文本文件。

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

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

下一步将所有工作表中的内容合并到一个名为＆＃34; Combined＆＃34;的新工作表中。

然后，所有床单，但＆＃34;合并＆＃34;被删除

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

这就是我被困住的地方：我能够让宏工作正常，直到我添加了一个＆＃34; For Loop＆＃34;它旨在打开数字命名的文件夹，并在＆＃34; enron_excel＆＃34;中使用数字名称保存它们。文件夹中。

但是当我运行代码时，请查看＆＃34; enron_excel＆＃34;文件夹，似乎＆＃34;合并＆＃34;步骤已被遗漏。有谁知道发生了什么事？

谢谢。

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

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:\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

我只是基于你如何描述你想要的东西。虽然没经过测试您需要添加对 Microsoft Scripting Runtime。 HTH。

的引用

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

1 个答案: