使用VBA在工作簿文件夹中循环编码？

JC11 发表于 Dev

JC11

我有一个文件夹，其中包含许多具有相同格式的Excel文件。我修改了以下代码来确定日期并将其重新格式化，其中“ i”根据第2列的最后一行确定范围内的单元格数。

Sub Test()
   Dim i As Long
   i = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row
   With Range("K3:K" & i)
        .Formula = "=DATE(A3,G3,H3)"
        .NumberFormat = "ddmmmyyyy"
   End With  
End Sub

我想在文件夹中的所有工作簿上执行此代码。我在stackoverflow上发现了以下问题：

用于遍历指定文件夹中的所有excel文件并从特定单元格提取数据的代码

它不会遍历我的所有文件，并且仅适用于我打开的第一个excel文件。如何在文件夹中的所有工作簿中循环这段代码？以下是我到目前为止的内容。

Sub Test()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook
Dim i As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch

            .LookIn = "C:\Test"
            .FileType = msoFileTypeExcelWorkbooks

                If .Execute > 0 Then
                    For lCount = 1 To .FoundFiles.Count

                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

   i = wbResults.Worksheets("Sheet1").Cells(wbResults.Worksheets("Sheet1").Rows.Count, 2).End(xlUp).Row
   With wbResults.Worksheets("Sheet1").Range("K3:K" & i)
        .Formula = "=DATE(A3,G3,H3)"
        .NumberFormat = "ddmmmyyyy"
   End With

                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

德米特里·帕夫利夫（Dmitry Pavliv）

Application.FileSearchExcel 2007和更高版本不支持。尝试以下代码（用于循环浏览文件夹中文件的代码来自@mehow的网站）

Sub PrintFilesNames()
    Dim file As String
    Dim wbResults As Workbook
    Dim i As Long
    Dim myPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    myPath = "D:\" ' note, path ends with back slash

    file = Dir$(myPath & "*.xls*")

    While (Len(file) > 0)
        Set wbResults = Workbooks.Open(Filename:=myPath & file, UpdateLinks:=0)

        With wbResults.Worksheets(Split(file, ".")(0))
            i = .Cells(.Rows.Count, 2).End(xlUp).Row
            With .Range("K3:K" & i)
                 .Formula = "=DATE(A3,G3,H3)"
                 .NumberFormat = "ddmmmyyyy"
            End With
        End With

        wbResults.Close SaveChanges:=True
        'get next file
        file = Dir
    Wend

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub