通过使用VBA的工作簿文件夹循环代码？ [英] Looping a code through a folder of workbooks with VBA?

问题描述

我有一个文件夹与一些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 Sub 
  

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

用于循环指定文件夹中的所有excel文件的代码，并从特定单元格中拉取数据

它不循环遍历我的所有文件，只适用于我打开的第一个excel文件。
我如何循环这个代码通过文件夹中的所有工作簿？以下是我到目前为止。

  Sub Test（）
 Dim lCount As Long 
 Dim wbResults作为工作簿
 Dim wbCodeBook As Workbook 
 Dim i As Long 
 
 Application.ScreenUpdating = False 
 Application.DisplayAlerts = False 
 Application.EnableEvents = False 
 
错误恢复下一步
设置wbCodeBook = ThisWorkbook 
 With Application.FileSearch 
 .NewSearch 
 
 .LookIn =C：\Test 
 .FileType = msoFileTypeExcelWorkbooks 
 
如果.Execute> 0然后
对于lCount = 1到PublishFiles.Count 
 
设置wbResults = Workbooks.Open（文件名：=。FoundFiles（lCount），UpdateLinks = =）
 
i = wbResults.Worksheets（Sheet1）。单元格（wbResults.Worksheets（Sheet1）。Rows.Count，2）.End（xlUp）.Row 
使用wbResults.Worksheets（Sheet1）。范围（K3：K& i）
 .Formula == DATE（A3，G3，H3）
 .NumberFormat =ddmmmyyyy
结束
 
 wbResults.Close SaveChanges：= False 
 Next lCount 
 End If 
 End With 
 On Error GoTo 0 
 Application.ScreenUpdating = True 
应用程序.DisplayAlerts = True 
 Application.EnableEvents = True 
 End Sub 
  

解决方案

Application.FileSearch 不受Excel 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：\注意，路径以斜杠结尾
 
 file = Dir $（myPath&* .xls *）
 
 While（Len（file）> 0）
设置wbResults = Workbooks.Open（文件名：= myPath&文件，UpdateLinks：= 0）
 
使用wbResults.Worksheets分割（文件，。）（0））
i = .Cells（.Rows.Count，2）.End（xlUp）.Row 
 With .Range（K3：K& ）
 .Formula == DATE（A3，G3，H3）
 .NumberFormat =ddmmmyyyy
结束W ith 
结束
 
 wbResults.Close SaveChanges：= True 
'获取下一个文件
 file = Dir 
 Wend 
 
 Application.DisplayAlerts = True 
 Application.ScreenUpdating = True 
 End Sub 
  

I have a folder with a number of excel files all with the same format. I have modified the following code to determine the date and reformat it, where "i" determines the number of cells in the range based on the last row of column 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

I would like to perform this code on all the workbooks in my folder. I have found the following question on stackoverflow:

Code for looping through all excel files in a specified folder, and pulling data from specific cells

It does not loop through all my files, and only works on the first excel file I have opened. How can I loop this code through all workbooks in a folder? Below is what I have so far.

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

解决方案

Application.FileSearch doesn't supported by Excel 2007 and later. Try this code (code for looping through files in a folder was taken from @mehow's site)

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

这篇关于通过使用VBA的工作簿文件夹循环代码？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！