Loop through files in a folder using VBA?

后端 未结 6 2308
南笙
南笙 2020-11-21 04:40

I would like to loop through the files of a directory using vba in Excel 2010.

In the loop, I will need:

  • the filename, and
  • the date at which
相关标签:
6条回答
  • 2020-11-21 04:55

    Try this one. (LINK)

    Private Sub CommandButton3_Click()
    
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim xWs As Worksheet
    Dim xWb As Workbook
    Dim FolderName As String
    Application.ScreenUpdating = False
    Set xWb = Application.ThisWorkbook
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = xWb.Path & "\" & xWb.Name & " " & DateString
    MkDir FolderName
    For Each xWs In xWb.Worksheets
        xWs.Copy
        If Val(Application.Version) < 12 Then
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            Select Case xWb.FileFormat
                Case 51:
                    FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If Application.ActiveWorkbook.HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56:
                    FileExtStr = ".xls": FileFormatNum = 56
                Case Else:
                    FileExtStr = ".xlsb": FileFormatNum = 50
            End Select
        End If
        xFile = FolderName & "\" & Application.ActiveWorkbook.Sheets(1).Name & FileExtStr
        Application.ActiveWorkbook.SaveAs xFile, FileFormat:=FileFormatNum
        Application.ActiveWorkbook.Close False
    Next
    MsgBox "You can find the files in " & FolderName
    Application.ScreenUpdating = True
    
    End Sub
    
    0 讨论(0)
  • 2020-11-21 04:56

    The Dir function is the way to go, but the problem is that you cannot use the Dir function recursively, as stated here, towards the bottom.

    The way that I've handled this is to use the Dir function to get all of the sub-folders for the target folder and load them into an array, then pass the array into a function that recurses.

    Here's a class that I wrote that accomplishes this, it includes the ability to search for filters. (You'll have to forgive the Hungarian Notation, this was written when it was all the rage.)

    Private m_asFilters() As String
    Private m_asFiles As Variant
    Private m_lNext As Long
    Private m_lMax As Long
    
    Public Function GetFileList(ByVal ParentDir As String, Optional ByVal sSearch As String, Optional ByVal Deep As Boolean = True) As Variant
        m_lNext = 0
        m_lMax = 0
    
        ReDim m_asFiles(0)
        If Len(sSearch) Then
            m_asFilters() = Split(sSearch, "|")
        Else
            ReDim m_asFilters(0)
        End If
    
        If Deep Then
            Call RecursiveAddFiles(ParentDir)
        Else
            Call AddFiles(ParentDir)
        End If
    
        If m_lNext Then
            ReDim Preserve m_asFiles(m_lNext - 1)
            GetFileList = m_asFiles
        End If
    
    End Function
    
    Private Sub RecursiveAddFiles(ByVal ParentDir As String)
        Dim asDirs() As String
        Dim l As Long
        On Error GoTo ErrRecursiveAddFiles
        'Add the files in 'this' directory!
    
    
        Call AddFiles(ParentDir)
    
        ReDim asDirs(-1 To -1)
        asDirs = GetDirList(ParentDir)
        For l = 0 To UBound(asDirs)
            Call RecursiveAddFiles(asDirs(l))
        Next l
        On Error GoTo 0
    Exit Sub
    ErrRecursiveAddFiles:
    End Sub
    Private Function GetDirList(ByVal ParentDir As String) As String()
        Dim sDir As String
        Dim asRet() As String
        Dim l As Long
        Dim lMax As Long
    
        If Right(ParentDir, 1) <> "\" Then
            ParentDir = ParentDir & "\"
        End If
        sDir = Dir(ParentDir, vbDirectory Or vbHidden Or vbSystem)
        Do While Len(sDir)
            If GetAttr(ParentDir & sDir) And vbDirectory Then
                If Not (sDir = "." Or sDir = "..") Then
                    If l >= lMax Then
                        lMax = lMax + 10
                        ReDim Preserve asRet(lMax)
                    End If
                    asRet(l) = ParentDir & sDir
                    l = l + 1
                End If
            End If
            sDir = Dir
        Loop
        If l Then
            ReDim Preserve asRet(l - 1)
            GetDirList = asRet()
        End If
    End Function
    Private Sub AddFiles(ByVal ParentDir As String)
        Dim sFile As String
        Dim l As Long
    
        If Right(ParentDir, 1) <> "\" Then
            ParentDir = ParentDir & "\"
        End If
    
        For l = 0 To UBound(m_asFilters)
            sFile = Dir(ParentDir & "\" & m_asFilters(l), vbArchive Or vbHidden Or vbNormal Or vbReadOnly Or vbSystem)
            Do While Len(sFile)
                If Not (sFile = "." Or sFile = "..") Then
                    If m_lNext >= m_lMax Then
                        m_lMax = m_lMax + 100
                        ReDim Preserve m_asFiles(m_lMax)
                    End If
                    m_asFiles(m_lNext) = ParentDir & sFile
                    m_lNext = m_lNext + 1
                End If
                sFile = Dir
            Loop
        Next l
    End Sub
    
    0 讨论(0)
  • 2020-11-21 04:59

    Dir seems to be very fast.

    Sub LoopThroughFiles()
        Dim MyObj As Object, MySource As Object, file As Variant
       file = Dir("c:\testfolder\")
       While (file <> "")
          If InStr(file, "test") > 0 Then
             MsgBox "found " & file
             Exit Sub
          End If
         file = Dir
      Wend
    End Sub
    
    0 讨论(0)
  • 2020-11-21 05:06

    Here's my interpretation as a Function Instead:

    '#######################################################################
    '# LoopThroughFiles
    '# Function to Loop through files in current directory and return filenames
    '# Usage: LoopThroughFiles ActiveWorkbook.Path, "txt" 'inputDirectoryToScanForFile
    '# https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba
    '#######################################################################
    Function LoopThroughFiles(inputDirectoryToScanForFile, filenameCriteria) As String
    
        Dim StrFile As String
        'Debug.Print "in LoopThroughFiles. inputDirectoryToScanForFile: ", inputDirectoryToScanForFile
    
        StrFile = Dir(inputDirectoryToScanForFile & "\*" & filenameCriteria)
        Do While Len(StrFile) > 0
            Debug.Print StrFile
            StrFile = Dir
    
        Loop
    
    End Function
    
    0 讨论(0)
  • 2020-11-21 05:10

    Dir function loses focus easily when I handle and process files from other folders.

    I've gotten better results with the component FileSystemObject.

    Full example is given here:

    http://www.xl-central.com/list-files-fso.html

    Don't forget to set a reference in the Visual Basic Editor to Microsoft Scripting Runtime (by using Tools > References)

    Give it a try!

    0 讨论(0)
  • 2020-11-21 05:18

    Dir takes wild cards so you could make a big difference adding the filter for test up front and avoiding testing each file

    Sub LoopThroughFiles()
        Dim StrFile As String
        StrFile = Dir("c:\testfolder\*test*")
        Do While Len(StrFile) > 0
            Debug.Print StrFile
            StrFile = Dir
        Loop
    End Sub
    
    0 讨论(0)
提交回复
热议问题