Question

我知道有类似的问题，但我已经尝试了所有解决方案代码但没有成功。我是VBA的初学者，我想要完成的是：

将文件从sfol复制到dfol
对于dfol中的每个文件，如果存在“摘要”选项卡，请更改单元格I3
对于dfol中的每个文件，如果存在“sheet2”选项卡，请更改数据透视过滤器

代码运行并且dfol中的第一个文件的更改已完成，但它甚至没有打开其余的每个文件。我需要它来打开每个文件。另外作为旁注，最后的msgbox没有弹出，所以我认为代码甚至没有完整的过程。

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

其他问题：

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

非常感谢任何帮助！

Answer 1

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

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

使用SaveAs更改打开的工作簿的名称。

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

在SaveAs之后，wb将成为原始文件的新副本。

使用on error resume next更直接地在摘要工作表上更改数据。

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

VBA循环遍历文件夹

1 个答案: