VBA循环遍历满足两个条件的文件

时间:2017-09-26 20:19:46

标签: excel vba do-while

以下是根据用户的搜索条件循环浏览文件夹中文件的工作代码。该文件夹将在一年中增长到超过1000个文件,因此,不是每次宏运行时循环遍历所有文件,我想添加第二个标准,将文件上的时间戳与保存在文件上的时间戳进行比较作为最后一次运行。 LastUpdateDate在模块顶部以日期格式设置为变量,旧的时间戳在代码的开头保存到它。

我尝试了这个,但它给我留下了运行时错误。这是可行的使用Do While,还是我需要看另一种格式?我还尝试将日期比较嵌套在if下的Do While语句中,但却出现了其他错误。

Do While FileName <> "" and FileDateTime(FileName) > LastUpdateDate

本节的工作代码:

FileName = Dir(FolderName & "*" & MyCriterion & "*" & ".xl??")   

'Loop through all matching files
Do While FileName <> ""
    'Open the next matching workbook
    Workbooks.Open (FolderName & FileName)
    Sheets("Report Data").Select
    'Call GrabTheData
    GrabTheData

    'Close the workbook
    Workbooks(FileName).Close savechanges:=False

    'Get the name of the next match in folder

    FileName = Dir
Loop

End Sub

1 个答案:

答案 0 :(得分:1)

两件事:

FileDateTime

FileDateTime需要完整的文件路径,而不仅仅是文件名

循环和条件

当(条件)不再为真时,

Do While (condition)停止执行该块。

也就是说,只要(条件)为假,它就会停止执行。我不相信这是预期的行为。

在循环中放置一个If (condition)块。这将遍历匹配MyCriterion的每个工作簿,但仅对匹配(条件)的工作簿进行操作。

示例(包含建议)

Sub GrabAllData(ByVal FolderName As String, ByVal MyCriterion As String)

    Dim FileName As String
    Dim LastUpdateDate As Date
    Dim wb As Workbook

    LastUpdateDate = ThisWorkbook.Worksheets("Parameters").Range("LastUpdateDate").Value 'Named Range called LastUpdateDate on sheet "Parameters" in ThisWorkbook

    'Make sure FolderName ends in a backslash
    If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"

    'Get matching files for MyCriterion
    FileName = Dir(FolderName & "*" & MyCriterion & "*" & ".xl??")

    'Loop through all matching files
    Do While FileName <> ""
        If FileDateTime(FolderName & FileName) > LastUpdateDate Then 'FileDateTime requires the full file path, not just the file name
            'Open the next matching workbook - work with the workbook directly, rather than working with ActiveWorkbook, ActiveSheet and Selections
            Set wb = Workbooks.Open(FileName:=FolderName & FileName, ReadOnly:=True)

            'Call GrabTheData on the workbook
            GrabTheData wb

            'Close the workbook
            wb.Close SaveChanges:=False
        End If
        'Get the name of the next match in folder
        FileName = Dir
    Loop

    Set wb = Nothing

End Sub

Sub GrabTheData(ByRef wb As Workbook)

    Dim wsOut As Worksheet, wsIn As Worksheet
    Set wsOut = ThisWorkbook.Worksheets("Aggregated Data") 'Worksheet called "Aggregated Data" in ThisWorkbook
    Set wsIn = wb.Worksheets("Report Data")

    ' ### Manipulate the data and write to wsOut, no need to work with Selections ###

End Sub