腳本變更多個Excel工作簿

Question

我試圖使大的變化了許多的Excel工作簿（超過20）。每個工作簿都包含大約16張單獨的工作表，並且我想編寫一個腳本，它將遍歷每個工作簿，並且工作表包含裏面的內容並編寫/修改我需要的單元格。我需要保持所有的字符串驗證，宏和格式。所有的工作簿都是2007年的格式。

我已經看過蟒蛇擅長libaries和PHPexcel，但宏，按鈕，公式，字符串驗證和格式和新的工作簿被寫入時不存。有沒有簡單的方法來做到這一點，或者我將不得不單獨打開每個工作簿並提交更改。我試圖避免在VBscript中創建一個宏，並且不得不單獨打開每個工作簿來提交我需要的更改。

Answer 1

我避免與多個工作簿就像是一個痛苦的瘟疫工作，如果這是一個正在進行的要求，那麼我會建議看回您的工作簿的設計，看是否可以合併回一個工作簿。我經常看到每個月都保存的工作簿，他們應該有一張工作簿，每張工作簿包含原始數據（其中每行代表一個月份），然後是另一張用於查看用戶選擇的原始數據的顯示工作表。這是一個非常大的概括，你可能會處於完全不同的情況。

如果一次過 - 我知道它不是你想要的，但我認爲你會通過使用VBA的工作簿最好的循環。喜歡的東西（未經測試）：

Excel 2003中：

Sub AdjustMultipleFiles() 
Dim lCount As Long 
Dim wbLoopBook As Workbook 
Dim wsLoopSheet As Worksheet 

With Application 
    .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False 
End With 

With Application.FileSearch 
     .NewSearch 
     '// Change path to suit 
     .LookIn = "C:\MyDocuments" 
     '// ALL Excel files 
     .FileType = msoFileTypeExcelWorkbooks 
     '// Uncomment if file naming convention needed 
     '.Filename = "Book*.xls" 

      '// Check for workbooks 
      If .Execute > 0 Then 
       '// Loop through all. 
       For lCount = 1 To .FoundFiles.Count 
        '// Open Workbook x and Set a Workbook variable to it 
        Set wbLoopBook = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0) 
         '// Loop through all worksheets 
         For Each wsLoopSheet In wbLoopBook.Worksheets 
          '//Update your worksheets here... 



         Next wsLoopSheet 
        '// Close Workbook & Save 
        wbLoopBook.Close SaveChanges:=True 
        '// Release object variable 
        Set wbLoopBook = Nothing 
      Next lCount 
     End If 

End With 

With Application 
    .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True 
End With 

End Sub 

對於Excel 2007+：

Sub AdjustMultipleFiles() 
    Dim sFileName As String 
    Dim wbLoopBook As Workbook 
    Dim wsLoopSheet As Worksheet 

    With Application 
     .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False 
    End With 

    '// Change path to suit 
    ChDir "C:\Documents" 

    '// ALL Excel 2007 files 
    sFileName = Dir("*.xlsx") 

    Do While sFileName <> "" 
     '// Open Workbook x and Set a Workbook variable to it 
     Set wbLoopBook = Workbooks.Open(Filename:=sFileName, UpdateLinks:=0) 
     '// Loop through all worksheets 
     For Each wsLoopSheet In wbLoopBook.Worksheets 
     '//Update your worksheets here... 


     Next wsLoopSheet 
     '// Close Workbook & Save 
     wbLoopBook.Close SaveChanges:=True 
     '// Release object variable 
     Set wbLoopBook = Nothing 
     '//Next File 
     sFileName = Dir 
     '//End Loop 
    Loop 

    With Application 
     .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True 
    End With 

End Sub 

Excel 2007中+（FileSystemObject的 - LateBinding）

Sub AdjustMultipleFiles() 
    Dim wbLoopBook As Workbook 
    Dim wsLoopSheet As Worksheet 

    With Application 
     .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False 
    End With 

    With CreateObject("Scripting.FileSystemObject") 
     '// Change path to suit 
     For Each File In .GetFolder("C:\Documents").Files 
      '// ALL Excel 2007 files 
      If .GetExtensionName(File) = "xlsx" Then 
       '// Open Workbook x and Set a Workbook variable to it 
       Set wbLoopBook = Workbooks.Open(Filename:=File.Path, UpdateLinks:=0) 
       '// Loop through all worksheets 
       For Each wsLoopSheet In wbLoopBook.Worksheets 
        '//Update your worksheets here... 
       Next wsLoopSheet 
       '// Close Workbook & Save 
       wbLoopBook.Close SaveChanges:=True 
       '// Release object variable 
       Set wbLoopBook = Nothing 
      End If 
     Next File 
    End With 


    With Application 
     .ScreenUpdating = True: .DisplayAlerts = True: .EnableEvents = True 
    End With 
End Sub 

Answer 2

當我需要爲了遍歷文件，我使用了thread on ozgrid中的一些代碼，它使用了Dir命令，避免版本問題，同時保留使用通配符過濾文件名的功能。

Function FileList(fldr As String, Optional fltr As String = "*.*") As Variant 
    Dim sTemp As String, sHldr As String 
    If Right$(fldr, 1) <> "\" Then fldr = fldr & "\" 'append backslash if not already supplied 
    sTemp = Dir(fldr & fltr) 
    If sTemp = "" Then 
     FileList = False 
     Exit Function 
    End If 
    Do 
     sHldr = Dir 
     If sHldr = "" Then Exit Do 
     sTemp = sTemp & "|" & sHldr 'ensures an array is returned 
    Loop 
    FileList = Split(sTemp, "|") 
End Function 

從我這裏得到一些代碼在一起，利用它：

Sub MySub() 
    Dim vList As Variant 
    Dim myWB As Workbook 
    Dim targetDir As String 
    targetDir = "C:\path\to\folder\" 
    If Right$(targetDir, 1) <> "\" Then targetDir = targetDir & "\" 
    vList = FileList(targetDir, "*.xl*") 'all file extensions starting with xl (xls, xlsx, xlsm, xla, xlsb, etc.) 
    For n = LBound(vList) To UBound(vList) 
     Set myWB = Workbooks.Open(targetDir & vList(n)) 
      'your code for each workbook here 
     myWB.Close 
    Next n 
End Sub 

Answer 3

您還可以使用PyWin32庫腳本，這與使用典型的COM技術的Python。這使您可以使用Python進行處理，並且仍然保存其他Python Excel庫可能無法處理的每個工作簿的所有額外部分。