循环遍历文件并在第一个文件之后退出循环答案

【问题标题】：Looping through files and after 1st file it exits loop循环遍历文件并在第一个文件之后退出循环
【发布时间】：2020-08-09 03:38:25
【问题描述】：

我正在尝试遍历文件夹中的文件，并根据特殊表中的设置对每个文件执行操作。这将是一个自动化过程，将根据我指定的内容为每个自动化下载文件，因此这是一个复杂的解决方案。

问题出在第一个 WHILE 上。它遍历第一个文件，执行所需的操作，然后停止循环。我的第二个文件“xwalks.xlsx”匹配第一个 IF 的条件，但它没有在那里处理。

这是该 ProjectID 的表格中的内容

这是文件夹中的文件

LoadCategoryID 说明如下

1 所有文件（下载所有文件，重命名，复制，从文件夹中删除

2 名称中包含字符串的文件（仅下载文件名中包含上述字符串的文件，重命名、复制、从文件夹中删除，如果 LoopThroughFile 为 -1，那么我正在运行程序（RunTest，它是注释掉。如果 LoopThroughFile 为 0，则程序将在一切完成后运行一次）

3 列出的文件（只下载与截图中的字段同名的文件，重命名，复制，从文件夹中删除，如果LoopThroughFile为-1，那么我正在运行程序（RunTest，它被注释掉了。如果 LoopThroughFile 为 0，则程序将在一切完成后运行一次）

一个项目可以拥有全部 3 个选项。

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

【问题讨论】：

通常你希望CurLoadFile = Dir 在循环的底部，而不是顶部。按照您的方式，您可以通过在循环体之前立即调用 Dir 来跳过第一个文件。
并摆脱DoCmd.SetWarnings False（编程中的无知不是幸福）。避免错误或处理它们，永远不要忽略它们。
第 1 步：正确格式化您的代码，使其更易于阅读（对您和我而言）：在同一制表位上对齐块；避免块的缩进超过 4 个空格。
应使用Application. SetOption 关闭这些警告。如果您收到无法抑制的警告，请仅围绕导致代码而不是整个函数！
另请阅读Getting started with VBA 和RubberduckVBA Blog。试试他们的add-in，因为它可以为改进代码提出很好的建议。

标签： vba ms-access

【解决方案1】：

如果有人需要这个。使用这里的代码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

【讨论】：