VBA - Копировать как путь

Question

Мне нужна помощь с требованием кодирования, которое я ранее не испытывал. Я просто просмотрел аналогичную проблему, поднятую здесь пару лет назад - VBA to Copy files using complete path and file names listed in Excel Object. Моя проблема аналогична, но несколько проще, чем OP.

У меня есть несколько папок, каждая из которых содержит около 100 небольших CSV-файлов; для каждой папки мне нужно скопировать путь для каждого файла на открытый лист. Каждая папка CSV-файлов имеет свою собственную связанную книгу.

В качестве примера, открытой книгой является F:\SM\M400AD.xlsm, а рабочий лист - CSV_List. Папка, содержащая CSV-файлы, - F:\SM\M400AD. Делать это вручную, моя последовательность затем:

Открыть папку F:\SM\M400AD

Выбрать все

Скопировать тракту

Вставить в Range("B11") из листа CSV_List

Когда я делаю это вручную, как описанный выше, я получаю список, который выглядит так:

"F:\SM\M400AD\AC1.csv" 
"F:\SM\M400AD\AC2.csv" 
"F:\SM\M400AD\AE.csv" 
"F:\SM\M400AD\AF.csv" 
"F:\SM\M400AD\AG.csv" 
"F:\SM\M400AD\AH1.csv" 
"F:\SM\M400AD\AH2.csv" 
"F:\SM\M400AD\AJ.csv" 

и на странице вниз, пока у меня есть список из 100 путей. Этот единственный список столбцов затем вставляется в рабочий лист CSV_List, начиная с Range("B11").

Мне нужно автоматизировать это и было бы признательно, если бы Гуру VBA любезно запрограммировал это для меня.

Answer 1

Такой вопроса было предложено ранее, например:

Loop through files in a folder using VBA?
List files in folder and subfolder with path to .txt file

Разница в том, вы хотите, чтобы «автоматизировать» его, что означает, что вы хотите выполнить код на рабочей книги Open события.

Как достичь этого?

1. Открыть F:\SM\M400AD.xlsm файл.
2. Перейти к код панели (ALT + F11)

3. Вставьте новый модуль и скопируйте ниже код

   Option Explicit 
   
   Sub EnumCsVFilesInCurrentFolder() 
   
       Dim sPath As String, sFileName As String 
       Dim i As Integer 
   
       sPath = ThisWorkbook.Path & "\" 
       i = 11 
       Do 
        If Len(sFileName) = 0 Then GoTo SkipNext 
        If LCase(Right(sFileName, 4)) = ".csv" Then 
         'replcae 1 with proper sheet name! 
         ThisWorkbook.Worksheets(1).Range("B" & i) = sPath & sFileName 
         i = i + 1 
        End If 
   
   SkipNext: 
        sFileName = Dir(sPath) 
       Loop While sFileName <> "" 
   
   End Sub 
   

4. Теперь перейдите в ThisWorkbook модуль и вставить ниже процедуры:

   Private Sub Workbook_Open() 
       EnumCsVFilesInCurrentFolder 
   End Sub 
   

5. Сохранить и закрыть книгу

Рабочая книга готова к использованию. Всякий раз, когда вы его открываете, будет выполнен макрос EnumCsVFilesInCurrentFolder.

Примечание: вам необходимо изменить код выше, чтобы ограничить количество записей.