VBS For Formatting Every Excel File

Question

i need a VBS for formatting all Excel files in a specified folder.

in fact this script will run everyday in different folders. if system date is 2014/01/02 then it should go to folder named c:\xxx\20140102 and run on every excel file.

the macro i recorded in excel is like this;

   Sub ACLDUZELT2()
'
' ACLDUZELT2 Macro
'

'
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.Font.Bold = True
    Rows("1:4000").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("A:CS").Select
    Columns("A:CS").EntireColumn.AutoFit
    Range("A1").Select
    ActiveWorkbook.Save
End Sub

Of course, files has to be saved like this formatting.

Thank you.

Answer 1

If you want to call an Excel macro from VBScript, you need to use the Run method on an Excel object.

In this script I'm assuming your macro is saved in an Excel file called "MyMacroFile.xlsm" and the files you want to process are in a folder called "xlfiles".

Set xl = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")
Set folder = fs.GetFolder(".\xlfiles")

xl.Visible = True
xl.Workbooks.Open "MyMacroFile.xlsm"
For Each file In folder.Files
    If Right(file.Name, 5) = ".xlsx" Then
        Set wb = xl.Workbooks.Open(file.Name)
        xl.Run "'MyMacroFile.xlsm'!ACLDUZELT2"
        wb.Save
        wb.Close
    End If
Next

xl.Quit

Answer 2

You can use FileSystemObject to do this, basically you just want to call your macro inside a loop over the File objects in that specific Folder.

Sub RunStuff()
Dim path As String
path = "C:\xxx\" & Format(Now(),"YYYYMMDD")  '## Modify as needed

Dim fldr as Object
Dim fl as Object
Dim wb as Workbook

With CreateObject("Scripting.FileSystemObject")
    Set fldr = .GetFolder(path)
    For each fl in fldr.Files
        Set wb = Workbooks.Open(fl.Name)
        wb.Activate
        Call ACLDUZELT2
    Next
End With

Set fldr = Nothing
Set fl = Nothing

Answer 3

thank you for everything. in fact i took best parts of your answers and created a working vbs script.

    On Error Resume Next
Set objFiles = CreateObject("Excel.Application")
Set fs = CreateObject("Scripting.FileSystemObject")

Dim strNow, strDD, strMM, strYYYY, strFulldate
strYYYY = DatePart("yyyy",Now())
strMM = Right("0" & DatePart("m",Now()),2)
strDD = Right("0" & DatePart("d",Now()),2)

Dim strbugun 
strbugun=strYYYY & strMM & strDD

Dim path2
path2="C:\xxx\deneme\" & strbugun
Set folder = fs.GetFolder(path2)
Dim path

For Each file In folder.Files


path = path2 & "\" & file.Name

Set oxl = CreateObject("Excel.Application")
Set owb = oxl.Workbooks.Open (path)

    Set ows = owb.worksheets(1)
    ows.activate
    With ows
    .range("A1:CS1").Font.Bold = True
    .range("A1:CS4000").Font.Name = "Arial"
    .range("A1:CS4000").Font.Size = 10
    .columns("A:CS").EntireColumn.autofit
    End With


    Set ows2 = owb.worksheets(2)
    ows2.activate
    With ows2
    .range("A1:CS1").Font.Bold = True
    .range("A1:CS4000").Font.Name = "Arial"
    .range("A1:CS4000").Font.Size = 10
    .columns("A:CS").EntireColumn.autofit
    End With

    owb.save
    owb.close

Next