【问题标题】:VBA Macro to open/save/close workbooks in folder and subfoldersVBA宏打开/保存/关闭文件夹和子文件夹中的工作簿
【发布时间】:2019-08-13 09:48:46
【问题描述】:

我有以下代码可以打开/保存/关闭文件夹中的任何/所有工作簿。它工作得很好,但是,我还需要它来包含子文件夹。如果可能,代码需要在不受文件夹、子文件夹和文件数量限制的情况下工作。

我正在使用 Excel 2010,而且我是 VBA 新手 - 非常感谢任何帮助!

Sub File_Loop_Example()
    'Excel VBA code to loop through files in a folder with Excel VBA

    Dim MyFolder As String, MyFile As String

    'Opens a file dialog box for user to select a folder

    With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

    'stops screen updating, calculations, events, and statsu bar updates to help code run faster
    'you'll be opening and closing many files so this will prevent your screen from displaying that

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    'This section will loop through and open each file in the folder you selected
    'and then close that file before opening the next file

    MyFile = Dir(MyFolder & "\", vbReadOnly)

    Do While MyFile <> ""
        DoEvents
        On Error GoTo 0
        Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False
        ActiveWorkbook.Save
        Workbooks(MyFile).Close SaveChanges:=True
        MyFile = Dir
    Loop

    'turns settings back on that you turned off before looping folders

    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationManual

    MsgBox "Done!"

    End Sub

【问题讨论】:

  • @Error1004 回复应该会给您答案,但请注意 recursive UDF。搜索类似:recursive functions and its pitfalls
  • 如何将代码合并到上面的@Error 1004 回复中?还是将我现有的代码合并到其中?抱歉,如果这听起来很愚蠢-我对此很陌生!另外,我想保留我拥有的文件夹选择器 - 这可能吗?

标签: excel vba excel-2010


【解决方案1】:

对于任何感兴趣的人,我找到了一个替代方案,我设法适应并完全按照我的意愿行事:

Sub Loop_Example()

Dim MyFolder As String
Dim file As Variant, wb As Excel.Workbook

With Application.FileDialog(msoFileDialogFolderPicker)
       .AllowMultiSelect = False
       .Show
       MyFolder = .SelectedItems(1)
       Err.Clear
    End With

Application.ScreenUpdating = False

For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR """ & startFolder & "*.xl*"" /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
    Set wb = Workbooks.Open(file)
    ActiveWorkbook.Save
    wb.Close SaveChanges:=True
    Set wb = Nothing
Next

Application.ScreenUpdating = True

    MsgBox "Done!"

End Sub

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2016-01-25
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多