VBA怎样在一个文件夹中依次打开所有的工作簿

Posted 2023-05-09

我具体想知道VBA中，可不可以通过 For Each In .......next.所以我想知道是否可以通过这种方式打开，workbooks 的上一级是什么。
如果没有直接的上一级，可不可以通过某种方式得到。
如果这种方式打不开，可以通过怎样的方式打开。
打开顺序只是按照普通的排列方式排序，依次打开一遍即可，文件的名字不确定。
谢谢大神啦

Sub 打开() 
Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False \'冻结屏幕，以防屏幕抖动 
myPath = "c:\\a\\" \'在这里输入你的路径，即你存放工作簿的文件夹 
myFile = Dir(myPath & "*.xlsx") \'依次找寻指定路径中的*.xlsx文件 
Do While myFile <> "" \'当指定路径中有文件时进行循环 
If myFile <> ThisWorkbook.Name Then 
Set AK = Workbooks.Open(myPath & myFile) \'打开符合要求的文件 
End If 
\'在这里插入你要处理的代码
AK.close\'这里可以选择参数是否保存，你也可以删除这行代码，手动关闭文件
myFile = Dir \'找寻下一个*.xlsx文件 
Loop 
Application.ScreenUpdating = True \'解除冻结屏幕,此类语句一般成对使用 
End Sub 参考技术A 参考下面的代码：
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Application.ScreenUpdating = False
If MsgBox("需要操作的数据表是：EXCEL2003 格式，请选择：是！" & Chr(13) & "" & Chr(13) & "需要操作的数据表是：EXCEL2007 格式，请选择：否！", vbYesNo, "北极狐提示！！") = vbYes Then
S = "\*.xls"
ss = 4
Else
S = "\*.xlsx"
ss = 5:
End If
F = Dir(ThisWorkbook.Path & S)
Do While F > " "
If F <> ThisWorkbook.Name Then
Set xlBook = Workbooks.Open(ThisWorkbook.Path & "\" & F) '打开已经存在的EXCEL工件簿文件
For Each sh In xlBook.Worksheets '遍历工作表
with sh
'自己的代码
end with
Windows(ThisWorkbook.Name).Activate'回到打开的工作簿
Next
Windows(F).Close (true)'关闭打开的工作簿，并保存。
F = Dir
Loop
Application.ScreenUpdating = True

如何提示用户在 VBA 中选择文件位置以将文件合并到一个工作簿中

【中文标题】如何提示用户在 VBA 中选择文件位置以将文件合并到一个工作簿中

【英文标题】：How to prompt user to select file location in VBA to merge files into one workbook

【发布时间】：2022-01-23 09:22:42

【问题描述】：

我正在努力编写提示用户使用 FileDialog 选择文件夹路径的工作代码，但无法将其与将所需文件导入打开工作簿的另一个例程集成。以下是我到目前为止的代码，但我需要提示用户，而不是预先确定文件夹路径：

Sub MergeCsvFilesToWb()

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Dim fldr As FileDialog


    Application.ScreenUpdating = False
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the Folder where the '.csv' files are located."
        .AllowMultiSelect = False
        .Show
    End With
    FolderPath = fldr.SelectedItems(1)
    Filename = Dir(FolderPath & "*.csv*")
        Do While Filename <> ""
            Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
            
            For Each Sheet In ActiveWorkbook.Sheets
            
                Sheet.Copy After:=ThisWorkbook.Sheets(1)
            
            Next Sheet
            
            Workbooks(Filename).Close
            Filename = Dir()
        
        Loop
        
Application.ScreenUpdating = True

End Sub

感谢任何帮助

【问题讨论】：

请编辑您的问题并包括您使用FileDialog的尝试

@RaymondWu 现在更新了

调试您的代码并确保变量msoFileDialogFolderPicker 具有有效值（非零）。如果变量不存在，VB 不会警告你。你能解释一下当你尝试这样做时会发生什么意想不到的事情吗？

如果您查看FileDialog documentation（它是object documentation）及其示例，您会看到SelectedItems 属性包含所选文件夹/文件的集合。由于文件夹选择器只允许您选择 1 个文件夹，请尝试 FolderPath = fldr.SelectedItems(1)

会弹出文件对话框，但是一旦我选择了文件夹，文件就不会导入工作簿（新添加的行）。 @RaymondWu

【参考方案1】：

FileDialog 中选择的文件/文件夹可以在SelectedItems 属性中找到 (Documentation)

所以要将变量FolderPath 分配给选定的文件夹：

    Dim fldr As FileDialog
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the Folder where the '.csv' files are located."
        .Show
        
        Dim FolderPath As String
        FolderPath = .SelectedItems(1)
    End With

请注意，您应该处理用户未在对话框中选择任何文件夹（单击Cancel）的事件，以便更好的版本是：

    Dim fldr As FileDialog
    
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select the Folder where the '.csv' files are located."
        .Show
        
        Dim FolderPath As String
        If .SelectedItems.Count <> 0 Then
            FolderPath = .SelectedItems(1)
        Else
            'Code to handle event that nothing is selected
            'e.g.
            'Exit Sub
        End If
    End With

最后，返回的文件夹路径末尾没有斜杠，因此您需要：

将Filename = Dir(FolderPath & "*.csv*")修改为Filename = Dir(FolderPath & "\*.csv*")

将FolderPath = .SelectedItems(1)修改为FolderPath = .SelectedItems(1) & "\"