初始文件夹和多个 Select (FileDialog)

Question

我有 2 个关于 FileDialog 的问题。

下面的代码是将文件从另一个文件夹复制到另一个文件夹。但如果找不到该文件，它会打开 FileDialog 到 select 文件。

问题：

当打开 FileDialog 时，它会默认为 Documents 而不是 AltPath。
是否可以 select 2 个或更多文件使用 FileDialog 而不诉诸循环？

    Dim fso As Object
    Dim ws As Worksheet
    Dim targetFile As Object
    Dim S_Line As Long
    Dim BasePath As String
    Dim AltPath As String
    Dim AltPath2 As String
    Dim MainPath As String
    Dim NewPath As String
    Dim Position As String


    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ws = ActiveSheet

    BasePath = "Z:\Test\Folder\"
    AltPath = "B:\Test\Folder\"
    MainPath = BasePath & "File.xlsm"
    NewPath = "D:\Folder\"
    S_Line = 0
    Position = UCase(Trim(ws.Cells(R_Line, 8).Value2))



    If Position = "OK" Then
    If Right(MainPath, 1) = "\" Then
        MainPath = Left(MainPath, Len(MainPath) - 1)
    End If
    
    If fso.FileExists(MainPath) = True Then
    fso.CopyFile Source:=MainPath, Destination:=NewPath
        Else
    Do While S_Line < 2
    Set targetFile = Application.FileDialog(msoFileDialogFilePicker)
    With targetFile
        .Title = "Select a File"
        .AllowMultiSelect = True
        .InitialFolderName = AltPath
        If .Show <> -1 Then
            MsgBox "You didn't select anything"
            Exit Sub
        End If
        AltPath2 = .SelectedItems(1)
    End With
    fso.CopyFile Source:=AltPath2, Destination:=NewPath
    S_Line = S_Line + 1
    Loop
    End If

Answer 1

你没有回答我的澄清问题，你的问题不是很清楚。请测试下一个代码。它将在您需要的文件夹中打开对话框，然后将select编辑的项目复制到您想要的文件夹中。我评论了与您的环境严格相关的线路（Position、S_Line），因为我无法推断出它们是什么以及如何使用：

Sub copyFileSourceDest()
   Dim fso As Object
    Dim ws As Worksheet
    Dim AltPath2 As String
    Dim MainPath As String
    Dim NewPath As String
    Dim Position As String
    Const AltPath As String = "B:\Test\Folder\"
    Const BasePath As String = "Z:\Test\Folder\"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ws = ActiveSheet

    MainPath = BasePath & "File.xlsm"
    NewPath = ThisWorkbook.path & "\NewFold\" ' "D:\Folder\"
    'Position = UCase(Trim(ws.cells(R_Line, 8).Value2))



    'If Position = "OK" Then
        'the following sequence looks useless, since it is a FILE path:
        'If Right(MainPath, 1) = "\" Then
        '    MainPath = left(MainPath, Len(MainPath) - 1)
        'End If
        
        If fso.FileExists(MainPath) = True Then
                fso.CopyFile Source:=MainPath, Destination:=NewPath
        Else
                Dim item As Variant
                    With Application.FileDialog(msoFileDialogFilePicker)
                        .Title = "Select a File"
                        .AllowMultiSelect = True
                        '.InitialFolderName = AltPath 'it does not exist in this Dialog type
                        .InitialFileName = AltPath
                        If .Show <> -1 Then
                            MsgBox "You didn't select anything"
                            Exit Sub
                        End If
                        For Each item In .SelectedItems
                            AltPath2 = item
                            fso.CopyFile Source:=AltPath2, Destination:=NewPath
                        Next
                    End With
        End If
 'End If
End Sub

它将简单地复制（所有）文件给您 select 到 Dialog。不理解为什么在您的代码尝试时需要循环...

初始文件夹和多个 Select (FileDialog)

Initial Folder and Multiple Select (FileDialog)

excel

vba

filedialog