Подтвердить что ты не робот

Получить список файлов Excel в папке с помощью VBA

Мне нужно получить имена всех файлов Excel в папке, а затем внести изменения в каждый файл. Я получил часть "внести изменения". Есть ли способ получить список файлов .xlsx в одной папке, скажем D:\Personal и сохранить его в String Array.

Затем мне нужно перебирать список файлов и запускать макрос в каждом из файлов, которые, как я полагал, я могу сделать, используя:

Filepath = "D:\Personal\"
For Each i in FileArray
    Workbooks.Open(Filepath+i)
Next

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

Короче говоря, как я могу использовать VBA для получения списка имен файлов Excel в определенной папке?

4b9b3361

Ответ 1

Хорошо, это может сработать для вас, функция, которая берет путь и возвращает массив имен файлов в папке. Вы можете использовать оператор if, чтобы получить только файлы Excel при циклическом просмотре массива.

Function listfiles(ByVal sPath As String)

    Dim vaArray     As Variant
    Dim i           As Integer
    Dim oFile       As Object
    Dim oFSO        As Object
    Dim oFolder     As Object
    Dim oFiles      As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    Set oFiles = oFolder.Files

    If oFiles.Count = 0 Then Exit Function

    ReDim vaArray(1 To oFiles.Count)
    i = 1
    For Each oFile In oFiles
        vaArray(i) = oFile.Name
        i = i + 1
    Next

    listfiles = vaArray

End Function

Было бы неплохо, если бы мы могли просто получить доступ к файлам в объекте files по номеру индекса, но, похоже, это не работает в VBA по какой-либо причине (ошибка?).

Ответ 2

Вы можете использовать встроенную функцию Dir или FileSystemObject.

У каждого из них есть свои сильные и слабые стороны.

Функция Dir

Функция Dir - это встроенный, легкий метод для получения списка файлов. Преимущества его использования:

  • Легко использовать
  • Хорошая производительность (это быстро)
  • Поддержка подстановочных знаков

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

Public Sub ListFilesDir(ByVal sPath As String, Optional ByVal sFilter As String)

    Dim sFile As String

    If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If

    If sFilter = "" Then
        sFilter = "*.*"
    End If

    'call with path "initializes" the dir function and returns the first file name
    sFile = Dir(sPath & sFilter)

   'call it again until there are no more files
    Do Until sFile = ""

        Debug.Print sFile

        'subsequent calls without param return next file name
        sFile = Dir

    Loop

End Sub

Если вы измените какой-либо из файлов внутри цикла, вы получите непредсказуемые результаты. Лучше прочитать все имена в массив строк перед выполнением каких-либо операций с файлами. Вот пример, который основан на предыдущем. Это функция, которая возвращает строковый массив:

Public Function GetFilesDir(ByVal sPath As String, _
    Optional ByVal sFilter As String) As String()

    'dynamic array for names
    Dim aFileNames() As String
    ReDim aFileNames(0)

    Dim sFile As String
    Dim nCounter As Long

    If Right(sPath, 1) <> "\" Then
        sPath = sPath & "\"
    End If

    If sFilter = "" Then
        sFilter = "*.*"
    End If

    'call with path "initializes" the dir function and returns the first file
    sFile = Dir(sPath & sFilter)

    'call it until there is no filename returned
    Do While sFile <> ""

        'store the file name in the array
        aFileNames(nCounter) = sFile

        'subsequent calls without param return next file
        sFile = Dir

        'make sure your array is large enough for another
        nCounter = nCounter + 1
        If nCounter > UBound(aFileNames) Then
            'preserve the values and grow by reasonable amount for performance
            ReDim Preserve aFileNames(UBound(aFileNames) + 255)
        End If

    Loop

    'truncate the array to correct size
    If nCounter < UBound(aFileNames) Then
        ReDim Preserve aFileNames(0 To nCounter - 1)
    End If

    'return the array of file names
    GetFilesDir = aFileNames()

End Function

Объект файловой системы

Объект файловой системы - это библиотека для операций ввода-вывода, которая поддерживает объектную модель для работы с файлами. Плюсы для этого подхода:

  • Intellisense
  • Надежная объектная модель

Вы можете добавить ссылку на "Объектную модель хоста сценариев Windows" (или "Среду выполнения сценариев Windows") и объявить ваши объекты следующим образом:

Public Sub ListFilesFSO(ByVal sPath As String)

    Dim oFSO As FileSystemObject
    Dim oFolder As Folder
    Dim oFile As File

    Set oFSO = New FileSystemObject
    Set oFolder = oFSO.GetFolder(sPath)
    For Each oFile In oFolder.Files
        Debug.Print oFile.Name
    Next 'oFile

    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing

End Sub

Если вы не хотите intellisense, вы можете сделать так, не устанавливая ссылку:

Public Sub ListFilesFSO(ByVal sPath As String)

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oFile As Object

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(sPath)
    For Each oFile In oFolder.Files
        Debug.Print oFile.Name
    Next 'oFile

    Set oFile = Nothing
    Set oFolder = Nothing
    Set oFSO = Nothing

End Sub

Ответ 3

Dim iIndex as Integer
Dim ws As Excel.Worksheet
Dim wb      As Workbook
Dim strPath As String
Dim strFile As String

strPath = "D:\Personal\"
strFile = Dir(strPath & "*.xlsx")

Do While strFile <> ""
    Set wb = Workbooks.Open(Filename:=strPath & strFile)

    For iIndex = 1 To wb.Worksheets.count
        Set ws = wb.Worksheets(iIndex)

        'Do something here.

    Next iIndex

 strFile = Dir 'This moves the value of strFile to the next file.
Loop

Ответ 4

Если все, что вам нужно, это имя файла без расширения файла

Dim fileNamesCol As New Collection
Dim MyFile As Variant  'Strings and primitive data types aren't allowed with collection

filePath = "c:\file directory" + "\"
MyFile = Dir$(filePath & "*.xlsx")
Do While MyFile <> ""
    fileNamesCol.Add (Replace(MyFile, ".xlsx", ""))
    MyFile = Dir$
Loop

Для вывода на лист Excel

Dim myWs As Worksheet: Set myWs = Sheets("SheetNameToDisplayTo")
Dim ic As Integer: ic = 1

For Each MyFile In fileNamesCol
    myWs.Range("A" & ic).Value = fileNamesCol(ic)
    ic = ic + 1
Next MyFile

В основном на основе техники, подробно описанной здесь: https://wordmvp.com/FAQs/MacrosVBA/ReadFilesIntoArray.htm

Ответ 5

Что касается ответа с голосованием, он мне понравился, за исключением того, что если результирующий массив "listfiles" используется в формуле массива {CSE}, все значения списка выводятся в горизонтальной строке. Чтобы они вышли в вертикальном столбце, я просто сделал массив двухмерным следующим образом:

ReDim vaArray(1 To oFiles.Count, 0)
i = 1
For Each oFile In oFiles
    vaArray(i, 0) = oFile.Name
    i = i + 1
Next