Need help with do while loop

peBowl

New Member
Joined
Jul 20, 2021
Messages
5
Office Version
  1. 2019
Platform
  1. Windows
  2. MacOS
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:

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
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Hi and welcome to MrExcel

You must clear the variable collection xFiles.

After this line
VBA Code:
xStrPath = "G:\Reko\scans\scan" & a & j & "\DIFF_DATA_UNBINNED\"

Add this line:
VBA Code:
        'clean xFiles
        Set xFiles = Nothing
 
Upvote 0
Solution
Hi and welcome to MrExcel

You must clear the variable collection xFiles.

After this line
VBA Code:
xStrPath = "G:\Reko\scans\scan" & a & j & "\DIFF_DATA_UNBINNED\"

Add this line:
VBA Code:
        'clean xFiles
        Set xFiles = Nothing
Many, many thanks @DanteAmor, I really appreciate that! I just implemented it and it works fine!
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top