VBA Выбор нескольких путей к файлам и сохранение в ячейках

Question

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

Dim FileFldr As FileDialog
Dim FileName, OrigFilePath, FileType, FilePath, CustID As String
Dim LastAttRow As Long
Dim vrtSelectedItem As Variant
CustID = txtID.Value
Set FileFldr = Application.FileDialog(msoFileDialogFilePicker)

With FileFldr
   .AllowMultiSelect = True
   .Title = "Select file to attach"
   .Filters.Add "All Files", "*.*", 1
   If .Show <> -1 Then GoTo NoSelection

   For Each vrtSelectedItem In .SelectedItems
   Next

    FilePath = .SelectedItems()
    FileName = Dir(FilePath)
    FileType = Right(FileName, Len(FileName) - InStr(Dir(FileName), "."))

   With Sheet6
        LastAttRow = .Range("D9999").End(xlUp).Row + 1 
        .Range("D" & LastAttRow).Value = CustID 
        .Range("E" & LastAttRow).Value = FileName
        .Range("F" & LastAttRow).Value = FileType
        .Range("G" & LastAttRow).Value = FilePat
        .Range("H" & LastAttRow).Value = "=Row()"

   End With 
   NoSelection:
   End With 
   Sheet6.Activate

End Sub

Answer 1

Вот ваш код с парой изменений. Я думаю, что он делает то, что вы ищете:

Sub Test()
  Dim FileFldr As FileDialog
  Dim FileName As String, OrigFilePath As String
  Dim FileType As String, FilePath As String, CustID As String
  Dim LastAttRow As Long
  Dim vrtSelectedItem As Variant
  CustID = txtID.Value
  Set FileFldr = Application.FileDialog(msoFileDialogFilePicker)

With FileFldr
 .AllowMultiSelect = True
 .Title = "Select file to attach"
 .Filters.Add "All Files", "*.*", 1
If .Show <> -1 Then GoTo NoSelection

For Each vrtSelectedItem In .SelectedItems

 FilePath = Left(vrtSelectedItem, InStrRev(vrtSelectedItem, "\"))
 FileName = Right(vrtSelectedItem, Len(vrtSelectedItem) - InStrRev(vrtSelectedItem, "\"))
 FileType = Right(FileName, Len(FileName) - InStr(Dir(FileName), "."))

With Sheet6
 LastAttRow = .Range("D9999").End(xlUp).Row + 1
 .Range("D" & LastAttRow).Value = CustID
 .Range("E" & LastAttRow).Value = FileName
 .Range("F" & LastAttRow).Value = FileType
 .Range("G" & LastAttRow).Value = FilePath
 .Range("H" & LastAttRow).Value = "=Row()"
End With
Next
NoSelection:
End With
Sheet6.Activate
End Sub

Answer 2

Это аналогичный способ, при котором каждый из файлов приписывается к отдельной строке в столбцах от D до H.

Обратите внимание, что если вы запускаете это дважды, что выбрало второевремя перезапишет то, что уже присутствует, и не добавится к концу. Чтобы изменить это поведение, вам понадобится другая переменная для хранения и сохранения вашего количества файлов, затем в следующий раз при записи массива на лист начните свой диапазон с вашего предыдущего количества файлов +1, затем конечный диапазон с предыдущим количеством файлов + ваш новый файлсосчитать.

    Sub newtest()

    Dim FileFldr As FileDialog
    Dim FileName, OrigFilePath, FileType, FilePath, CustID As String

    CustID = txtID.Value

    Set FileFldr = Application.FileDialog(msoFileDialogFilePicker)

    With FileFldr
       .AllowMultiSelect = True
       .Title = "Select file to attach"
       .Filters.Add "All Files", "*.*", 1
       If .Show <> -1 Then GoTo NoSelection

        Dim ArrayCount As Long: RowCount = 0 'counter to hold what number in the array your on : 'set this number to 0 where array starts
        Dim FileArray As Variant 'declare the array which will hold all the files user selected
        Dim FileCount As Long: FileCount = .SelectedItems.Count 'declare the long which will hold the amount of files the user has selected - set to the amount of selected files
            ReDim FileArray(FileCount, 4) 'redim the array to the size of the amount of files

       'loop through each of the selected items and assign its values to an address in the array
       For Each vrtSelectedItem In .SelectedItems
            FilePath = vrtSelectedItem
            FileName = Dir(FilePath)
            FileType = Right(FileName, Len(FileName) - InStr(Dir(FileName), "."))

            FileArray(ArrayCount, 0) = CustID
            FileArray(ArrayCount, 1) = FileName
            FileArray(ArrayCount, 2) = FileType
            FileArray(ArrayCount, 3) = FilePath
            FileArray(ArrayCount, 4) = "=Row()"
            ArrayCount = ArrayCount + 1
       Next

        With Sheet6
            .Range(Cells(1, 4), Cells(FileCount, 8)).Value = FileArray 'set range to what the array is and then put values from array in that range
        End With

    NoSelection:
       End With
       Sheet6.Activate

    End Sub