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

时间:2015-07-14 18:07:03

标签: vba excel-vba excel-2010 excel

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

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

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

我查看了this,但是,我无法打开文件,因为它以Variant格式存储了这些名称。

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

5 个答案:

答案 0 :(得分:19)

您可以使用内置的Dir函数或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

如果您更改循环内的任何文件,您将得到不可预测的结果。在对文件执行任何操作之前,最好将所有名称读入字符串数组中。这是一个基于前一个示例的示例。这是一个返回字符串数组的函数:

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

文件系统对象

文件系统对象是用于IO操作的库,它支持用于操作文件的对象模型。这种方法的优点:

  • 智能感知
  • 强大的对象模型

您可以添加对“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

如果你不想要智能感知,你可以这样做,而无需设置参考:

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

答案 1 :(得分:4)

Column("amount", Integer, nullable = False, default = 1)

答案 2 :(得分:1)

如果您只需要没有扩展名的文件名

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

答案 3 :(得分:0)

关于建议的答案,我喜欢它,除了如果在数组公式{CSE}中使用生成的“ listfiles”数组,则列表值全部出现在水平行中。为了使它们出现在垂直列中,我简单地将数组二维化,如下所示:

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

答案 4 :(得分:0)

Sub test()
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder1 = FSO.GetFolder(FromPath).Files
    FolderPath_1 = "D:\Arun\Macro Files\UK Marco\External Sales Tool for Au\Example Files\"
    Workbooks.Add
    Set Movenamelist = ActiveWorkbook
    For Each fil In folder1
        Movenamelist.Activate
        Range("A100000").End(xlUp).Offset(1, 0).Value = fil
        ActiveCell.Offset(1, 0).Select
    Next
End Sub