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

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