VBA循环遍历文件夹中的每个文件

我知道类似的问题已经被问到,但我已经尝试了所有的解决scheme代码,但没有成功。 我是VBA的初学者,我正在努力完成的是:

  1. 将文件从sfol复制到dfol
  2. 对于现在在dfol中的每个文件,如果“摘要”选项卡存在,请更改单元格I3
  3. 对于dfol中的每个文件,如果“sheet2”选项卡存在,请更改pivot filter

代码运行并且对dfol中的第一个文件进行了更改,但是它甚至不打开其余文件。 我需要它来打开每个文件。 另外作为一个方面说明,最后的最后msgbox不会popup,所以我认为代码甚至不运行其全过程。

Sub GenerateReports() 'Generate Seed Run Validation Reports Macro Dim wb As Workbook Dim MainFile, dfol, sfol As String Dim vDate, Fname, myExtension As String Dim wsCount As Integer Dim fso Application.ScreenUpdating = False Application.DisplayAlerts = False 'Confirm the user wants to proceed If MsgBox("Compile?", vbYesNo) = vbNo Then Exit Sub 'Define current workbook MainFile = ThisWorkbook.Name 'Define Dates vDate = "Potato" 'Set file path sfol = "I:\ABCFolder" dfol = "I:\DEFFolder" 'Copy all files from source folder Set fso = CreateObject("Scripting.FileSystemObject") fso.CopyFolder sfol, dfol 'Target Path with extension myExtension = "*.xls*" dfol = dfol & "\" Fname = Dir(dfol & myExtension) 'Loop through files in folder Do While Fname <> "" Set wb = Workbooks.Open(fileName:=dfol & Fname) 'Ensure workbook opened DoEvents wsCount = wb.Worksheets.Count For i = 1 To wsCount 'Update Date on Summary tab If wb.Worksheets(i).Name = "Summary" Then wb.Worksheets(i).Range("I3") = vDate End If Next i 'save changes and close wb.Close SaveChanges:=True 'Ensure workbook closed DoEvents 'Get next file name Fname = Dir Loop '***************************** End of Macro *************************** Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox ("Assumptions Compiled!") End Sub 

其他问题:

  1. 每次打开文件时,都会询问是否要更新链接。 我需要它只是不更新​​。
  2. 我还需要将以“2017 …”开始的文件夹中的所有文件重新命名为“2018 …”

任何帮助是极大的赞赏!

您可以指定在打开时不更新链接。

 Set wb = Workbooks.Open(fileName:=dfol & Fname, UpdateLinks:=false) 

使用另存为更改打开的工作簿的名称。

 wb.saveas FileName:=replace(wb.name, "2017", "2018") 

在SaveAs之后, wb将是原始的新副本。

使用on error resume next一个更直接的path来更改摘要工作表上的数据。

 on error resume next with wb.worksheets("summary") .Range("I3") = vDate end with on error goto 0