用于格式化每个Excel文件的VBS

我需要一个VBS来格式化指定文件夹中的所有Excel文件

事实上，这个脚本每天都会在不同的文件夹中运行。如果系统日期为2014/01/02，则应转到名为c:\xxx\20140102的文件夹，并在每个excel文件上运行

我在excel中记录的宏是这样的

   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

当然，文件必须以这种格式保存

---

谢谢。

您可以使用FileSystemObject来执行此操作，基本上，您只需要在特定的

文件夹中的
文件
对象上的循环中调用宏即可

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

如果要从VBScript调用Excel宏，则需要在Excel对象上使用

在这个脚本中，我假设您的宏保存在一个名为“MyMacroFile.xlsm”的Excel文件中，并且您要处理的文件位于一个名为“xlfiles”的文件夹中

谢谢你所做的一切。事实上，我从你的答案中选取了最好的部分，并创建了一个工作的vbs脚本

    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

查看FileSystemObject（脚本运行时参考的一部分）以使用文件和文件夹。或者，您可以使用“Dir”Good job。我建议您在循环之外创建oxl，并在脚本末尾调用oxl.Quit。否则，您将为每个文件创建一个新的Excel应用程序实例，并且您永远不会退出它们，因此在该脚本运行后，您将有50个不可见的Excel副本正在运行。确实工作得很好。实际上我在找一个退出手术，但找不到。非常感谢。
    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