Looping through files and after 1st file it exits loop

Question

I'm trying to loop through files in folder and perform actions on each file based on what's setup in a special table. This will be an automated process that will download files for each automation based on what i specified, hence this convoluted solution.

The problem is with the first WHILE. It loops through the first file, does what's needed and then stops looping. my 2nd file "xwalks.xlsx" matches criteria for the first IF, but it's not processed there.

here's what's in the table for this ProjectID

Here are the files in the folder

LoadCategoryID explanations are below

1 All Files (download all files, rename, copy, delete from the folder

2 Files With String In The Name (only download files that have a string from above in the file name, rename, copy, delete from folder, and if LoopThroughFile is -1, then I'm running procedure (RunTest, it's commented out. if LoopThroughFile is 0, then the procedure will be run once after everything is done)

3 Listed Files (only download files that have the same name as the field in the screenshot, rename, copy, delete from folder, and if LoopThroughFile is -1, then I'm running procedure (RunTest, it's commented out. if LoopThroughFile is 0, then the procedure will be run once after everything is done)

one project can have all 3 options.

Public Function RunLoadFilesTest()
    
    Application.SetOption "Confirm Action Queries", False
    Application.SetOption "Confirm Record Changes", False
    Application.SetOption "Confirm Document Deletions", False
    
    Dim MyObj       As Object, MySource As Object
    Dim Rs1         As DAO.Recordset
    Dim VExcelFileName As String, VRenameTo As String, VLoadXLSMFileName As String, NewFileName As String, CurFileName As String
    Dim CurLoadFile As Variant
    Dim VLoadCategoryID As Long, VLoopThroughFile As Long
    

Dim MainProjectName As String, UFProjectName As String
Dim RunDate As Date, StartRunTime As Date
Dim ProjectPath As String, FormattedDate As String, ProjectMonthlyPath As String, ProjectNetworkLoadPath As String, ProjectLocalLoadPath As String, ProjectPreviousPath As String
Dim ReportYear As Long, ReportQuarter As Long


ProjectPath = "\\dddd\AutomationResults\" & MainProjectName & "\"
ProjectMonthlyPath = ProjectPath & FormattedDate & "\"

RunDate = Format(DateAdd("q", 1, DateAdd("m", -2, DateSerial(Year(Date), (DatePart("q", Date) * 3) - 3, 1))) - 1, "dd-mmm-yyyy")
ReportYear = Year(RunDate)
ReportQuarter = DatePart("q", RunDate)
FormattedDate = ReportYear & "-Q" & ReportQuarter



ProjectMonthlyPath = ProjectPath & FormattedDate & "\"

ProjectNetworkLoadPath = ProjectPath & "_Load\"
ProjectLocalLoadPath = CurPath & "_Load\"

ProjectPreviousPath = ProjectPath & "_Previous\"


    
    If Len(Dir$(ProjectLocalLoadPath & "*.*")) > 0 Then
        Kill ProjectLocalLoadPath & "*.*"
    End If
    
    Debug.Print DCount("LoadFileID", "AP_LoadFiles", "LoopThroughFile=-1 And ProjectID=" & CurProjectID)
    If DCount("LoadFileID", "AP_LoadFiles", "LoopThroughFile=-1 And ProjectID=" & CurProjectID) > 0 Then
        
        CurLoadFile = Dir(ProjectNetworkLoadPath)
        
        While (CurLoadFile <> "")
            CurFileName = CurLoadFile
            
            Set Rs1 = CurrentDb.OpenRecordset("SELECT * FROM AP_LoadFiles WHERE LoopThroughFile=-1 And ProjectID=" & CurProjectID & " Order by LoadFileID Desc")
            
            Do Until Rs1.EOF
                
                VLoadCategoryID = Rs1("LoadCategoryID")
                VLoopThroughFile = Rs1("LoopThroughFile")
                
                If Not IsNull(Rs1("RenameTo")) And Rs1("RenameTo") <> "" Then
                    NewFileName = Rs1("RenameTo")
                Else
                    NewFileName = CurFileName
                End If
                
                If (VLoadCategoryID = 2 And CurFileName Like "*" & Rs1("ExcelFileName") & "*") Or (VLoadCategoryID = 3 And CurFileName = Rs1("ExcelFileName")) Or VLoadCategoryID = 1 Then
                    FileCopy ProjectNetworkLoadPath & CurFileName, ProjectLocalLoadPath & NewFileName
                    
                    If Not IsNull(Rs1("LoadXLSMFileName")) And Rs1("LoadXLSMFileName") <> "" Then
                        ExcelApp.Workbooks.Open CurPath & Rs1("LoadXLSMFileName") & ".xlsm", True
                        ExcelApp.Visible = False
                        ExcelApp.Quit
                    End If
                    
                    FileCopy ProjectNetworkLoadPath & CurFileName, ProjectPreviousPath & FormattedDate & "_" & CurFileName
                    
                    If Len(Dir$(ProjectNetworkLoadPath & CurFileName)) > 0 Then
                        Kill ProjectNetworkLoadPath & CurFileName
                    End If
                    'RunTest
                    Debug.Print "2 looping " & CurFileName
                    
                    If Len(Dir$(ProjectLocalLoadPath & CurFileName)) > 0 Then
                        Kill ProjectLocalLoadPath & CurFileName
                    End If
                    Exit Do
                End If
                
                Rs1.MoveNext
            Loop
            
            Rs1.Close
            Set Rs1 = Nothing
            
            CurLoadFile = Dir
        Wend
    End If
    
    If DCount("LoadFileID", "AP_LoadFiles", "LoopThroughFile=0 And ProjectID=" & CurProjectID) > 0 Then
        
        CurLoadFile = Dir(ProjectNetworkLoadPath)
        
        While (CurLoadFile <> "")
            CurFileName = CurLoadFile
            
            Set Rs1 = CurrentDb.OpenRecordset("SELECT * FROM AP_LoadFiles WHERE LoopThroughFile=0 And ProjectID=" & CurProjectID & " Order by LoadFileID Desc")
            
            Do Until Rs1.EOF
                
                VLoadCategoryID = Rs1("LoadCategoryID")
                VLoopThroughFile = Rs1("LoopThroughFile")
                
                If Not IsNull(Rs1("RenameTo")) And Rs1("RenameTo") <> "" Then
                    NewFileName = Rs1("RenameTo")
                Else
                    NewFileName = CurFileName
                End If
                
                If (VLoadCategoryID = 2 And CurFileName Like "*" & Rs1("ExcelFileName") & "*") Or (VLoadCategoryID = 3 And CurFileName = Rs1("ExcelFileName")) Or VLoadCategoryID = 1 Then
                    FileCopy ProjectNetworkLoadPath & CurFileName, ProjectLocalLoadPath & NewFileName
                    
                    If Not IsNull(Rs1("LoadXLSMFileName")) And Rs1("LoadXLSMFileName") <> "" Then
                        ExcelApp.Workbooks.Open CurPath & Rs1("LoadXLSMFileName") & ".xlsm", True
                        ExcelApp.Visible = False
                        ExcelApp.Quit
                    End If
                    
                    FileCopy ProjectNetworkLoadPath & CurFileName, ProjectPreviousPath & FormattedDate & "_" & CurFileName
                End If
                
                Rs1.MoveNext
            Loop
            
            Rs1.Close
            Set Rs1 = Nothing
            
            CurLoadFile = Dir
        Wend
        
        'RunTest
        Debug.Print "2 run once after loaded all files"
        
        If Len(Dir$(ProjectLocalLoadPath & CurFileName)) > 0 Then
            Kill ProjectLocalLoadPath & CurFileName
        End If
    End If
    
    
    If DCount("LoadFileID", "AP_LoadFiles", "ProjectID=" & CurProjectID) = 0 Then
        
        Debug.Print "3 RUNNING For those that had no load instructions"
        'RunTest
    End If
    
    Application.SetOption "Confirm Action Queries", True
    Application.SetOption "Confirm Record Changes", True
    Application.SetOption "Confirm Document Deletions", True
    
End Function

Typically you want that `CurLoadFile = Dir` at the bottom of the loop, not at the top. The way you have it, you skip the first file by immediately calling `Dir` before the loop body. — Tim Williams, Aug 09 '20 at 06:34
And get rid of `DoCmd.SetWarnings False` (ignorance is not bliss in programming). Avoid errors or handle them, never just ignore them. — ComputerVersteher, Aug 09 '20 at 07:21
Step 1: properly format your code so it is easier to read (for you and for me): align blocks on the same tab stop; avoid indentations of blocks by more than 4 spaces. — Paul Ogilvie, Aug 09 '20 at 08:19
@computerversteher lol I thought this turns off warnings like "are you sure you want to update these 24 rows" and stuff like that. I have them turned off on my computer by default but others do not. — lalachka, Aug 09 '20 at 16:12
Those warnings should be turned off by using [Application. SetOption](https://learn.microsoft.com/de-de/office/troubleshoot/access/setoption-disable-warning-messages). If you get a warning that you can't suppress, just surround the causing code, not the whole function! — ComputerVersteher, Aug 09 '20 at 16:18
@TimWilliams huge thank you!!! i have another similar problem :(, updated the post — lalachka, Aug 09 '20 at 19:15
If you have a *new* problem you need to include in your edit a description of what the new problem is - it's not clear to me what has changed (and it's not reasonable to expect folks here to do a diff between the original and the edited version...) — Tim Williams, Aug 09 '20 at 19:53
First: cleanup comments (delete)! Then I'm missing `CurProjectID` definition (you use [Option Explicit](https://riptutorial.com/excel-vba/example/3554/always-use--option-explicit-)?), also don't use `CurrentDb` inside a loop, store it to a var! Your code looks pretty wet (means opposite of [DRY](https://en.wikipedia.org/wiki/Don%27t_repeat_yourself)) — ComputerVersteher, Aug 09 '20 at 20:38
@computerversteher I'm not a good coder, I wouldn't be asking basic questions here if I was. My strength is my imagination and the ability to come up with ways to minimize manual work for any process. And then Google pieces of code that let's me accomplish what I need :) Will cleanup. CurProjectId is a variable that tells the program which automation (there are 60) to pull data for. For this project that value is 16, which tells you nothing :) this is a master db to control automations — lalachka, Aug 09 '20 at 20:41
Did you search the web on "why not use CurrentDb" (e.g several SO answers)? Always do that first! Delete the comments on this question not code (but good code only needs rare comments)! — ComputerVersteher, Aug 09 '20 at 21:01
@computerversteher no, i didn't search, busy trying to solve this issue. but i will search later. code comments will be gone once i fix what i'm doing. and i deleted some of my comments in the thread. — lalachka, Aug 09 '20 at 21:04
On first look , i can't see any mayor problem, but as your code is tl:dr it's hard to say. Try to [debug](https://bettersolutions.com/vba/debugging/index.htm) yourself with a [breakpoint](https://bettersolutions.com/vba/debugging/breakpoints.htm) on the `IF`clause. So you can check values and see why it doesn't match criteria. Make your code easier to understand by refactoring parts to small functions/subs e.g setting of `NewName`should be a function with `Rs1("RenameTo")`and `CurFileName`passed as arguments. Look for code that repeats only with different parameters. — ComputerVersteher, Aug 10 '20 at 08:59
After you refactored **working** code as much as you can, you can post it on [codereview](https://codereview.stackexchange.com/) to get more help. — ComputerVersteher, Aug 10 '20 at 09:01
Also read [Getting started with VBA](https://riptutorial.com/vba) and [RubberduckVBA Blog](https://rubberduckvba.wordpress.com/2019/07/11/im-not-a-programmer/). Try their [add-in](https://rubberduckvba.com/) as it can make nice suggestions to improve code. — ComputerVersteher, Aug 10 '20 at 09:05
@computerversteher I did try to debug, was at it for hours. I put debug.print at every step and couldn't figure it out. I only post here after I'm stuck. But I got it, used a different piece of code off the net, I posted an answer. Thank you! Will read the links and check out the add on, if my job lets me install it. — lalachka, Aug 10 '20 at 10:10
@computerversteher meant to say "thank you" for Rubberduck, I love it! All my code looks perfect now. What a cool tool. — lalachka, Apr 10 '21 at 21:39

score 0 · Answer 1 · edited Aug 10 '20 at 08:39

in case someone needs this. used code from here Loop through folder, renaming files that meet specific criteria using VBA?

Public Function RunLoadFiles()

Application.SetOption "Confirm Action Queries", False
Application.SetOption "Confirm Record Changes", False
Application.SetOption "Confirm Document Deletions", False

Dim MyObj       As Object, MySource As Object
Dim Rs1         As DAO.Recordset
Dim VExcelFileName As String, VRenameTo As String, VLoadXLSMFileName As String, NewFileName As String, CurFileName As String
Dim CurLoadFile As Variant
Dim VLoadCategoryID As Long, VLoopThroughFile As Long

RunVariables

'    ODBCConnsRefs
   
'clear local LOAD folder
If Len(Dir$(ProjectLocalLoadPath & "*.*")) > 0 Then
    Kill ProjectLocalLoadPath & "*.*"
End If


Dim fls, f

Set fls = GetFilesInFolder(ProjectNetworkLoadPath, "*.*")
For Each f In fls
    CurFileName = Mid(f, Len(ProjectNetworkLoadPath) + 1, 99)
    
    Set Rs1 = CurrentDb.OpenRecordset("SELECT * FROM QLoadFiles WHERE LoopThroughFile=0")

        Do Until Rs1.EOF

            If Not IsNull(Rs1("ExcelFileName")) Then
            VExcelFileName = Rs1("ExcelFileName")
            End If


            VLoadCategoryID = Rs1("LoadCategoryID")

            If Not IsNull(Rs1("RenameTo")) Then
            VExcelFileName = Rs1("RenameTo")
                NewFileName = Rs1("RenameTo")
            Else
                NewFileName = CurFileName
            End If

            VLoopThroughFile = Rs1("LoopThroughFile")

            If Not IsNull(Rs1("LoadXLSMFileName")) Then
            VLoadXLSMFileName = Rs1("LoadXLSMFileName")
            End If


            If (VLoadCategoryID = 2 And CurFileName Like "*" & VExcelFileName & "*") Or (VLoadCategoryID = 3 And CurFileName = VExcelFileName) Or VLoadCategoryID = 1 Then

                FileCopy ProjectNetworkLoadPath & CurFileName, ProjectLocalLoadPath & NewFileName

                If VLoadXLSMFileName <> "" Then
                    ExcelApp.Workbooks.Open CurPath & VLoadXLSMFileName & ".xlsm", True
                    ExcelApp.Visible = False
                    ExcelApp.Quit
                End If

                FileCopy ProjectNetworkLoadPath & CurFileName, ProjectPreviousPath & FormattedDate & "_" & CurFileName

                If Len(Dir$(ProjectNetworkLoadPath & CurFileName)) > 0 Then
                    Kill ProjectNetworkLoadPath & CurFileName
                End If

            Debug.Print "Pass: 1, CurFileName: " & CurFileName & ", VLoadCategoryID: " & VLoadCategoryID & ", VLoopThroughFile: " & VLoopThroughFile & ", StringToMatch: " & Rs1("ExcelFileName")
                Exit Do
            End If

            Rs1.MoveNext
        Loop

        Rs1.Close
        Set Rs1 = Nothing
Next f
     
 



Set fls = GetFilesInFolder(ProjectNetworkLoadPath, "*.*")
For Each f In fls
    CurFileName = Mid(f, Len(ProjectNetworkLoadPath) + 1, 99)
    
 

    Set Rs1 = CurrentDb.OpenRecordset("SELECT * FROM QLoadFiles WHERE LoopThroughFile=-1")
    
        Do Until Rs1.EOF

            If Not IsNull(Rs1("ExcelFileName")) Then
            VExcelFileName = Rs1("ExcelFileName")
            End If


            VLoadCategoryID = Rs1("LoadCategoryID")

            If Not IsNull(Rs1("RenameTo")) Then
            VExcelFileName = Rs1("RenameTo")
                NewFileName = Rs1("RenameTo")
            Else
                NewFileName = CurFileName
            End If

            VLoopThroughFile = Rs1("LoopThroughFile")

            If Not IsNull(Rs1("LoadXLSMFileName")) Then
            VLoadXLSMFileName = Rs1("LoadXLSMFileName")
            End If

            If (VLoadCategoryID = 2 And CurFileName Like "*" & VExcelFileName & "*") Or (VLoadCategoryID = 3 And CurFileName = VExcelFileName) Or VLoadCategoryID = 1 Then
                FileCopy ProjectNetworkLoadPath & CurFileName, ProjectLocalLoadPath & NewFileName

            Debug.Print "Pass: 2, CurFileName: " & CurFileName & ", VLoadCategoryID: " & VLoadCategoryID & ", VLoopThroughFile: " & VLoopThroughFile & ", StringToMatch: " & Rs1("ExcelFileName")

                If Not IsNull(Rs1("LoadXLSMFileName")) And Rs1("LoadXLSMFileName") <> "" Then
                    ExcelApp.Workbooks.Open CurPath & Rs1("LoadXLSMFileName") & ".xlsm", True
                    ExcelApp.Visible = False
                    ExcelApp.Quit
                End If

                FileCopy ProjectNetworkLoadPath & CurFileName, ProjectPreviousPath & FormattedDate & "_" & CurFileName

                If Len(Dir$(ProjectNetworkLoadPath & CurFileName)) > 0 Then
                    Kill ProjectNetworkLoadPath & CurFileName
                End If

                'RunDefaultAutomations
                Debug.Print "2 looping " & CurFileName

                If Len(Dir$(ProjectLocalLoadPath & CurFileName)) > 0 Then
                    Kill ProjectLocalLoadPath & CurFileName
                End If
                Exit Do
            End If

            Rs1.MoveNext
        Loop

        Rs1.Close
        Set Rs1 = Nothing
    
Next f

 



If DCount("LoadFileID", "QLoadFiles") = 0 Or DCount("LoadFileID", "QLoadFiles", "LoopThroughFile=-1") = 0 Then
     
    Debug.Print "Pass 3 RUNNING For those that had no load instructions or no loops"
    'RunDefaultAutomations
End If

Application.SetOption "Confirm Action Queries", True
Application.SetOption "Confirm Record Changes", True
Application.SetOption "Confirm Document Deletions", True

End Function

Function GetFilesInFolder(Path As String, Optional Pattern As String = "") As Collection
Dim rv As New Collection, f
If right(Path, 1) <> "\" Then Path = Path & "\"
f = Dir(Path & Pattern)
Do While Len(f) > 0
    rv.Add Path & f
    f = Dir() 'no parameter
Loop
Set GetFilesInFolder = rv
End Function

Looping through files and after 1st file it exits loop

1 Answers1