Loop through all worksheets in all Excel workbooks in a folder to change the font, font size, and alignment of text in all cells

Question

On my hard drive I have a folder containing a number of Excel workbooks. I want to loop though all the worksheets in each of the Excel workbooks in this folder to change the font, font size, and alignment of text in all the cells.

From my own limited knowledge of VBA and from reading other related questions here on SO I have cobbled toghether the macro below which I have stored in Personal.xls.

As it is now it seems to loop through the workbooks but it is not formating the text in any of them.

    Sub Format_Workbooks()

    'This macro requires that a reference to Microsoft Scripting Routine

    'be selected under Tools\References in order for it to work.

    Application.DisplayAlerts = False

    Application.ScreenUpdating = False

    Dim fso As New FileSystemObject

    Dim source As Scripting.Folder

    Dim wbFile As Scripting.File

    Dim book As Excel.Workbook

    Dim sheet As Excel.Worksheet

    Set source = fso.GetFolder("C:\Documents and Settings\The Thing\My Documents\Excel Workbooks")

    For Each wbFile In source.Files

    If fso.GetExtensionName(wbFile.Name) = "xls" Then

      Set book = Workbooks.Open(wbFile.Path)

      For Each sheet In book.Sheets

        With sheet       

        .Cells.Font.Name = "Whatever font I want to use"

        .Cells.Font.Size = 10

        .Cells.HorizontalAlignment = xlLeft

        End With

      Next

      book.Close

    End If

    Next

End Sub

What changes do I need to make to have the macro work as intended?

Also, as I've never made use of the 'Microsoft Scripting Routine' before I'm wondering if the approach I've taken in writing this macro is correct for my stated goals or should it be rewritten from scratch?

Thanks for your help.

Answer 1

If the file types are mixed you may get an increase in performance with the Dir function as you can filter the file type, something like:

Edited as per Brett's suggestions

Sub FormatFiles()
    Const fPath As String = "D:\My Documents\"
    Dim sh As Worksheet
    Dim sName As String

    With Application
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    sName = Dir(fPath & "*.xls*")

    Do Until sName = ""
        With GetObject(fPath & sName)
            For Each sh In .Worksheets
                With sh
                    .Cells.HorizontalAlignment = xlLeft
                    .Cells.Font.Name = "Tahoma"
                    .Cells.Font.Size = 10
                End With
            Next sh
            .Close True
        End With
        sName = Dir
    Loop

    With Application
        .Calculation = xlAutomatic
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

Answer 2

The following statement means you do not see any warnings:

Application.DisplayAlerts = False

The warning you are missing is from:

book.Close

which asks if you would like to save the changes you have made. By ignoring this question, you are answering "No".

Recommended actions:

1. Delete Application.DisplayAlerts = False
2. Add book.Save before the close unless you want to confirm each save.