VBS格式化每個Excel文件

Question

我需要一個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 

當然，文件必須保存像這樣的格式。

謝謝。

Answer 1

如果你想打電話從VBScript一個Excel宏，您需要將Excel對象上使用的Run method。

在這個腳本中，我假設你的宏保存在名爲「MyMacroFile.xlsm」的Excel文件中，並且你想要處理的文件位於一個名爲「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

你可以使用FileSystemObject來做到這一點，基本上你只是想通過該特定的Folder中的File對象在循環中調用你的宏。

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

謝謝你的一切。事實上，我把你的答案的最好的部分，並創建一個工作的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