VBProjectを編集する(抜粋)

Install.vbs

If LCase(Right(WScript.FullName, Len("*Script.exe"))) <> "cscript.exe" Then
    Dim strArgs: strArgs = ""
    
    Dim i
    For i = 0 To WScript.Arguments.Count - 1
        strArgs = strArgs + " """ & WScript.Arguments(i) & """"
    Next

    Dim objWshShell: Set objWshShell = CreateObject("WScript.Shell")
    objWshShell.Run("cscript """ + WScript.ScriptFullName + """" + strArgs)
    
    WScript.Quit
End If

Main

Sub Main()
    Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
    Dim objWshShell: Set objWshShell = CreateObject("WScript.Shell")
    Dim objExcel: Set objExcel = CreateObject("Excel.Application")
    objExcel.Visible = False
    objExcel.DisplayAlerts = False

    Dim i
    Dim strFn
    Dim strCurDir: strCurDir = fso.GetParentFolderName(WScript.ScriptFullName)
    Dim objWorkbook
    For i = 0 To WScript.Arguments.Count - 1

        strFn = WScript.Arguments(i)

        If fso.GetExtensionName(strFn) = "xlsm" Then

            WScript.StdOut.WriteLine(strFn)

            fso.CopyFile strCurDir & "\" & strFn, strCurDir & "\" & fso.GetBaseName(strFn) & ".bkp"
            Set objWorkbook = objExcel.Workbooks.Open(strCurDir & "\" & strFn)

            With objWorkbook.VBProject 
                '既に存在するコンポーネントの上書き
                AddComponent objWorkbook.VBProject, "PrintDialog", "frm", strCurDir
                AddComponent objWorkbook.VBProject, "Printers", "cls", strCurDir
            End With

            objWorkbook.Save
            objWorkbook.Close
        End If
    Next

    Set fso = Nothing
    Set objWorkbook = Nothing
    objExcel.Quit
    Set objExcel = Nothing
End Sub

Sub AddComponent(ByVal objVBProject, ByVal strComponentName, ByVal strExtension, ByVal strCurDir)
    With objVBProject
        If ComponentsExists(objVBProject, strComponentName) Then
            '.VBComponents("PrintDialog").Export strCurDir & "\" & "PrintDialog.bkp"
            .VBComponents.Remove .VBComponents(strComponentName)
            WScript.StdOut.WriteLine(" - """ & strComponentName & """ was overwritten.")
        End If
        .VBComponents.Import(strCurDir & "\" & strComponentName & "." & strExtension)
    End With
End Sub

Function ComponentsExists(ByVal objVBProject, ByVal strComponentName)
    Dim i
    For i = 1 To objVBProject.VBComponents.Count
        If objVBProject.VBComponents(i).Name = strComponentName Then
            ComponentsExists = True
            Exit Function
        End If
    Next
    ComponentsExists = False
End Function