从目录中插入选定的文件名/路径

Question

我想在一张纸上构建一个从不同路径中选择的文件的列表。

在“A”列中我有文件名（带有扩展名），在“B”列中我有文件路径。

我想打开一个目录，突出显示该目录中的特定文件，并将它们的文件名和路径分别复制到 A 列和 B 列中的下一个可用行中。

我可以导入给定文件夹中所有文件的文件名和路径（如下所示），但我想选择特定文件来填充工作表，并粘贴到下一个可用行中。

Sub GetFileNames()

    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim i As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    ActiveSheet.Cells(1, 1) = "FileName"
    ActiveSheet.Cells(1, 2) = "FilePath"
    i = 1
    For Each xFile In xFolder.Files
        i = i + 1
        ActiveSheet.Cells(i, 1) = xFile.Name
        ActiveSheet.Cells(i, 2) = xPath
    Next

End Sub

Answer 1

只需为 FilePicker 添加另一个 FileDialog。允许它有多个选择。

Option Explicit

Sub GetFileNames()

    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim i As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    ' if headings not equal to this then clear page and set to this
    ActiveSheet.Cells(1, 1) = "FileName"
    ActiveSheet.Cells(1, 2) = "FilePath"
    i = 1       ' needs to be last used line

    Set xFiDialog = Application.FileDialog(msoFileDialogFilePicker)
    With xFiDialog
        .InitialFileName = xPath
        .Filters.Clear      ' Clear all the filters (if applied before).
        .Title = "Select 1 or more Files by holding down CTRL" ' Give the dialog box a title
        .Filters.Add "Files", "*.*", 1  ' show only a particular type of files.
        .AllowMultiSelect = True    ' allow users to select more than one file.

        ' Show the file.
        If .Show = True Then
            'Debug.Print "===="
            'Debug.Print .SelectedItems(1)           ' Get the complete file path.
            'Debug.Print Dir(.SelectedItems(1))      ' Get the file name.
            'Debug.Print "--"
            Dim j As Long
            For j = 1 To .SelectedItems.Count
               'Debug.Print .SelectedItems(j)
               i = i + 1
               ActiveSheet.Cells(i, 1) = .SelectedItems(j)
               ActiveSheet.Cells(i, 2) = xPath
            Next j
        End If
    End With


End Sub