Count and read each workbook in a folder

[dave8]

I have a folder with a bunch of workbooks. How to read each workbook in that folder, open it, perform some task, save and close the workbook, then read the next workbook and do the same. The number of workbooks in the folder will always be different. What I'm trying to do is put workbooks in a folder and run a macro to update some value(s) on the worksheet. And I need periodically to do this for a number of workbooks. Thanks for your help.

 

[brettdj]

Example attached below

This code will prompt for a directory (a default can be set with strDefaultFolder), it will then open each excel file in this folder, write the current date/time to A1 of sheet 1 then save and close each file

Cheers

Dave

Public Sub DoStuff()
    Dim Wb2 As Workbook
    Dim lngCalc As Long

    Dim StrPrefix
    Dim strFileName As String
    Dim strFolderName As String
    'variant declaration needed for the Shell object to use a default directory
    Dim strDefaultFolder As Variant

    'set default directory here if needed
    strDefaultFolder = "C:\temp"

    strFolderName = BrowseForFolder(strDefaultFolder)
    'Look for xls, xlsx, xlsm files
    strFileName = Dir(strFolderName & "\*.xls*")

    'Turn off screenupdating, events, alerts and set calculation to manual
    With Application
        .DisplayAlerts = False
        .EnableEvents = False
        .ScreenUpdating = False
        lngCalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    'set path outside the loop
    StrPrefix = strFolderName & IIf(bProcessFolder, "\", vbNullString)

    Do While Len(strFileName) > 0
        'Provide progress status to user
        Application.StatusBar = Left("Processing " & strFolderName & "\" & strFileName, 255)
        'Open each workbook in the folder of interest
        Set Wb2 = Workbooks.Open(StrPrefix & "\" & strFileName)
        With Wb2
            .Sheets(1).[a1] = Now()
            .Save
            'Close the opened workbook
            .Close False
        End With
        strFileName = Dir
    Loop

    With Application
        .CutCopyMode = False
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
        .Calculation = lngCalc
        .StatusBar = vbNullString
    End With
End Sub


Function BrowseForFolder(Optional OpenAt As Variant) As Variant
'From Ken Puls as used in his vbaexpress.com article
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=284

    Dim ShellApp As Object
    'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
                   BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    'Destroy the Shell Application
    Set ShellApp = Nothing

    'Check for invalid or non-entries and send to the Invalid error
    'handler if found
    'Valid selections can begin L: (where L is a letter) or
    '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select

    Exit Function

Invalid:
    'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
End Function

 

[dave8]

Thank you.