フォルダ内のすべてのファイルのExcelマクロを変更するVBScript

Question

私の現在の問題は、質問VBScript to loop through Excel-files and change macroとVBScript to add code to Excel workbookと密接に関連しています。だから私が解決したい問題は、フォルダ内のすべてのExcelファイルをループして、一部のファイルではDieseArbeitsmappeと、一部ではThisWorkbookと呼ばれるマクロを変更することです。次のコードはすべてのExcelを開き、保存しますが、VBComponentは変更されません。前回投稿したコードで作業したため、問題はコンポーネントを返す関数でなければなりません。

これは私の実際のコードです：

Set objFSO = CreateObject("Scripting.FileSystemObject") 
sFolder = "P:\Administration\Reports\operativ\Tagesbericht\templates\START07\TestTabsiNeu\" 
Set objExcel = CreateObject("Excel.Application") 
objExcel.Visible = True 
objExcel.DisplayAlerts = False 

On Error Resume Next 
For Each objFile In objFSO.GetFolder(sFolder).Files 

    Set objWorkbook = objExcel.Workbooks.Open(sFolder & objFile.Name) 

    Set component = extractedComponent(objWorkbook) 

    strCode = _ 
    "Sub WorkBook_Open()" & vbCr & _ 
    " Application.Run (""'CommonMacro.xlsm'!Workbook_Open"")" & vbCr & _ 
    "End Sub" 
    component.CodeModule.AddFromString strCode 

    objWorkbook.SaveAs "P:\Administration\Reports\operativ\Tagesbericht\templates\START07\TestTabsiNeu\" & objFile.Name 
    objWorkbook.Close 
    Set component = Nothing 
    Set objWorkbook = Nothing  
Next 

objExcel.Quit 
Set objFSO = Nothing 


Function extractedComponent(objWorkbook) 
    Err.Clear 
    Set comp = objWorkbook.VBProject.VBComponents("DieseArbeitsmappe") 
    If Err.Number = 0 Then 
     extractedComponent = comp 
     Exit Function 
    Else 
     Err.Clear 
     Set altComp = objWorkbook.VBProject.VBComponents("ThisWorkbook") 
     If Err.Number = 0 Then 
      extractedComponent = altComp 
      Exit Function 
     End If 
    End If 
End Function 

Answer 1

Set extractedComponent = comp 
Set extractedComponent = altComp 

関数からオブジェクトを返すために、あなたは、関数呼び出しが、それは&ができ、オブジェクトを返す理解できるような戻り値Setティンでなければなりません変数componentに適切に割り当てます。

何が失敗しているかをよりよく把握するために、エラーを有効にすることをおすすめします。