Hi everyone,
I am new to vba programming and I edited a code to extract several txt-Files from a folder to a new workbook, thereby, each txt file is copied to a separate worksheet. Since I have about 50 folders I wrote a loop to extract the data from the txt files.
The for loop works fine so far, but I always get the same error so I hope you can help me to fix the problem: for the first folder the script is working properly, but not for the next step because the loop goes on (J=2) but the script is searching for files located in the previous folder (J=1); that's why I assume that my mistake is in the Do While xFile <> "" Loop but I have no idea how to fix it. Can anyone of you guys help me out? I would really appreciate that. I searched for days on google as well as in forums but I wasn't able to find a solution.
Here is my code:
Many thanks in advance and best regards,
peBowl
I am new to vba programming and I edited a code to extract several txt-Files from a folder to a new workbook, thereby, each txt file is copied to a separate worksheet. Since I have about 50 folders I wrote a loop to extract the data from the txt files.
The for loop works fine so far, but I always get the same error so I hope you can help me to fix the problem: for the first folder the script is working properly, but not for the next step because the loop goes on (J=2) but the script is searching for files located in the previous folder (J=1); that's why I assume that my mistake is in the Do While xFile <> "" Loop but I have no idea how to fix it. Can anyone of you guys help me out? I would really appreciate that. I searched for days on google as well as in forums but I wasn't able to find a solution.
Here is my code:
VBA Code:
Sub Test()
Dim wb1 As Workbook
Dim xWb As Workbook
Dim xToBook As Workbook
Dim xStrPath As String
Dim xFileDialog As FileDialog
Dim xFile As String
Dim xFiles As New Collection
Dim I As Long
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
Application.DisplayAlerts = False
For J = 1 To 27 Step 1
If J < 10 Then a = "0"
If J = 10 Then a = ""
If J > 10 Then a = ""
Set wb1 = Workbooks.Add
Set wb1 = Application.ActiveWorkbook
xStrPath = "G:\Reko\scans\scan" & a & J & "\DIFF_DATA_UNBINNED\"
'If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
xFile = Dir(xStrPath & "*.txt")
Do While xFile <> ""
xFiles.Add xFile, xFile
xFile = Dir()
Loop
Set xToBook = ActiveWorkbook
If xFiles.Count > 0 Then
For I = 1 To xFiles.Count
Set wb1 = Workbooks.Open(xStrPath & xFiles.Item(I))
wb1.Worksheets(1).Copy after:=xToBook.Sheets(xToBook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = xFiles(I)
On Error GoTo 0
wb1.Close False
Next
Sheets("Tabelle1").Delete
End If
'specify safe directory & name
ActiveWorkbook.SaveAs Filename:="G:\Reko\scans\scan" & a & J & "\DIFF_DATA_UNBINNED\scan" & a & J & "_DIFF_DATA.xlsx"
ActiveWorkbook.Close SaveChanges:=False
Next J
Application.DisplayAlerts = True
End Sub
Many thanks in advance and best regards,
peBowl