open folder, manipulate files in excel, save excel files in new directory - vba

Question

I have a folder called "maildir". It contains folders named numerically. These folders contain text files.
I have hacked together a macro that opens the numerically named folder, opens its first text file, and copies the contents into Excel. It then opens the next file in the directory, and copies the new file into a new sheet in the same workbook.
Then, the procedure deletes all the rows below row five, for every sheet in the workbook.
The next step combines the content from all the sheets into a new sheet called "Combined".
Then, all sheets but "Combined" are deleted
The next step saves the workbook into a new folder called "enron_excel".
This is where I am stuck: I was able to get the macro to work fine until I added a "For Loop" which is designed to both open the numerically named folders, and save them with numerical names in the "enron_excel" folder.
But when I run the code, and look in the "enron_excel" folder, it seems that the "combined" step has been missed. Does anyone know what happened?
Thank you.
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

Why don't you use File System Object.
Something like:
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
I just based it on how you describe what you want. Not tested though.
You will need to add reference to Microsoft Scripting Runtime. HTH.