使用VBA获取文件夹中的Excel文件列表

Question

我需要获取文件夹中所有Excel文件的名称,然后对每个文件进行更改.我已经解决了"改变"部分.有没有办法.xlsx在一个文件夹中获取文件列表,D:\Personal并将其存储在字符串数组中.

然后我需要遍历文件列表并在我认为可以使用的每个文件上运行一个宏:

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

我一看这个,但是,我没能打开这些文件的原因,而是存储在名称Variant格式.

简而言之,我如何使用VBA获取特定文件夹中的Excel文件名列表？

Answer 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

如果我们只能通过索引号访问文件对象中的文件会很好,但是出于某种原因这似乎在VBA中被破坏了(bug？).

Answer 2

您可以使用内置的Dir函数或FileSystemObject.

• Dir功能:VBA:Dir功能

• FileSystemObject:VBA:FileSystemObject - 文件集合

对于简单的文件列表,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

如果你想要智能感知和更多的功能,除了获取文件名,我会建议FileSystemObject.您可以添加对"Windows脚本宿主对象模型"(或"Windows脚本运行时")的引用,并声明您的对象,如下所示:

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,你可以这样做,而无需设置参考:

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

Answer 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