Question

我有允许用户选择文件夹的VBA。用户选择文件夹后，该文件夹中的所有excel文件都将导入到当前工作表中。

我想将脚本更改为用户可以选择文件夹的位置-或-多个文件：

如果用户选择一个文件夹，它将导入该文件夹中的所有Excel文件如果用户选择文件，则仅导入所选文件

有什么想法吗？

这是我当前用于选择文件夹的脚本：

Dim sFolder As String
    ' Open the select folder prompt
    'With Application.FileDialog(msoFileDialogFolderPicker)
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select a Folder"
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        Else 'If Cancel is pressed then end
        MsgBox "Folder Selection was canceled by User"
        End
        End If
        
    End With

Path = sFolder & "/"
Filename = Dir(Path & "*.xls")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop
  Filename = Dir(Path & "*.csv")
  Do While Filename <> ""
  Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
     For Each Sheet In ActiveWorkbook.Sheets
     Sheet.Copy After:=ThisWorkbook.Sheets(1)
  Next Sheet
     Workbooks(Filename).Close
     Filename = Dir()
  Loop

Answer 1

由于有一个FileDialogFolderPicker和一个FileDialogFilePicker，但是没有一个对话框可以同时选择两者，因此我建议以下内容：

具有一个过程来询问用户他想选择什么。整个文件夹或单个文件。通过这种方式，运行一个过程以显示用于选择单个文件或整个文件夹的对话框。

您要对单个文件执行的操作（无论从哪个文件中选取的内容越少）应随后进入另一个过程YourSingleFileStuff。如果选择了完整文件夹，则SelectFolder将遍历所有文件并为每个文件运行YourSingleFileStuff。

通过这种方式，您可以获得干净且非重复的代码：

Option Explicit

'* this would be the sub you run
Public Sub ExampleProcedure()
    Select Case MsgBox("Do you want to select an entire Folder?", vbQuestion + vbYesNoCancel, "Select entire folder or single file")
        Case vbYes: SelectFolder
        Case vbNo: SelectFile
        Case Else
    End Select
End Sub


'* this handles single file selection only
Private Sub SelectFile()
    Dim sFile As String
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Select a single file"
        
        If .Show = -1 Then
            sFile = .SelectedItems(1)
        Else
            MsgBox "File selection was canceled by user.", vbExclamation
            Exit Sub
        End If
    End With
    
    MsgBox "'" & sFile & "' was selected."
    
    'call the procedure to do your single file stuff
    YourSingleFileStuff sFile
End Sub


'* this handles folder selection only
Private Sub SelectFolder()
    Dim sFolder As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Title = "Select an entire folder"
        
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        Else
            MsgBox "Folder selection was canceled by user.", vbExclamation
            Exit Sub
        End If
    End With
    
    MsgBox "'" & sFolder & "' was selected."
   
    'loop through all files in that folder
    Dim sFile As String
    sFile = Dir(sFolder & "\*") 'or eg. Dir(sFolder & "\*.xlsx") for only Excel files
    Do While Len(sFile) > 0
        'call the procedure to do your single file stuff for each file in the folder
        YourSingleFileStuff sFolder & "\" & sFile
        
        sFile = Dir 'next file
    Loop
End Sub


'* this handles all stuff you want to do with a single file
Private Sub YourSingleFileStuff(ByVal FileName As String)
    'here handle the things you want to do with your file
    
    Debug.Print FileName 'as an example I just print the file name into the immediate window
End Sub

允许用户选择文件夹或文件

1 个答案: