Need help with do while loop

[peBowl]

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:

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

 

[DanteAmor]

Hi and welcome to MrExcel

You must clear the variable collection xFiles.

After this line

xStrPath = "G:\Reko\scans\scan" & a & j & "\DIFF_DATA_UNBINNED\"

Add this line:

        'clean xFiles
        Set xFiles = Nothing

 

[peBowl]

Hi and welcome to MrExcel

You must clear the variable collection xFiles.

After this line

xStrPath = "G:\Reko\scans\scan" & a & j & "\DIFF_DATA_UNBINNED\"

Add this line:

        'clean xFiles
        Set xFiles = Nothing

Many, many thanks @DanteAmor, I really appreciate that! I just implemented it and it works fine!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.