Блог

Я хочу создать список выбранных файлов из разных путей на одном листе.

В столбце «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
  

Просто добавьте другой файловый каталог для FilePicker. Разрешите ему иметь несколько вариантов выбора.

 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