0

問題があります。同じ手順で Excel と Word のインスタンスの動作が異なります。コードを見てください。そこにあるアイデアは、さまざまな形式の組み合わせで Excel と Word のファイルを再保存する手順を用意することです。

問題は、Word と Excel の動作が異なることに気付いたことです。appWord と appExcel の型名は異なります。ある時点で appWord が Application から Object に変更され、それを閉じることができなくなります。それらに適用されるコードは同一であるため、動作の違いがわかりません。

Option Explicit
Dim fso
Dim appWord
Dim appExcel
Set fso = CreateObject("Scripting.FileSystemObject")

startWord
ResaveFiles appWord.Documents, "docx", 12, 0
appWord.quit

startExcel
ResaveFiles appExcel.Workbooks, "xlsx", 51, 56
appExcel.quit


MsgBox "All done."


Sub ResaveFiles(appType, srcExtName, srcExtNum, tmpExtNum)
Dim objFile
Dim objOpenFile
Dim strDirectory
    For Each objFile in fso.GetFolder(".").Files
        If lcase(fso.GetExtensionName(objFile)) = srcExtName Then
                If typeName(appType) = "Documents" Then StartWord
                If typeName(appType) = "Workbooks" Then StartExcel  
            Set objOpenFile = appType.Open(objFile.path)
            strDirectory = fso.BuildPath(objOpenFile.path, fso.GetBaseName(objOpenFile.name) & "._temp")
            objOpenFile.SaveAs strDirectory, tmpExtNum
            objOpenFile.Close
            msgBox typename(appType) & objFile
            msgBox typename(appWord) 'First typename test
            msgBox Typename(appExcel)
                If typeName(appType) = "Documents" Then appWord.Quit
                If typeName(appType) = "Workbooks" Then appExcel.Quit   
            set objOpenFile = appType.Open(strDirectory)
            objOpenFile.SaveAs objFile.path, srcExtNum
            objOpenFile.Close
            fso.DeleteFile(strDirectory)
            msgBox typename(appWord) 'Second typename test
    msgBox Typename(appExcel)
        End If  
    Next
    End Sub

'Start Word
 Sub StartWord
            Set appWord = CreateObject("Word.Application")
                appWord.visible = false
                appWord.DisplayAlerts = false
    End Sub

'Start Excel
Sub StartExcel
            Set appExcel = CreateObject("Excel.Application")
                appExcel.visible = false
                appExcel.DisplayAlerts = false
End Sub

私は次の方法でそれをテストしました (2 つの型名テストを使用) - 使用可能な単語ファイルがある場合、最初に appWord が Application で appExcel が空で、次に Object に変更され、appExcel は空のままです (この場合、サブプロシージャは AppWord.Quit で終了します)。Word ファイルがなく、スクリプトが Excel を処理している場合、最初に appWord が Object で appExcel が Application であり、次に appWord が Object で appExcel が Application のままです。この場合、appExcel でサブプロシージャが終了してもエラーは発生しません。終了する。

4

1 に答える 1

1

多分私は間違っている、私の意見です:

If typeName(appType) = "Documents" Then appWord.Quit
If typeName(appType) = "Workbooks" Then appExcel.Quit   

set objOpenFile = appType.Open(strDirectory)

appType「Excel.Application」または「Word.Application」の新しいコピーをインスタンス化するResaveFiles Subに入る前に何を参照しているappWord.Documentsかを参照しており、それぞれのケースで、アプリケーションにQUITを指示します。appExcel.Workbooks問題は、単語の場合にエラーが発生した理由ではありません。私の観点からは、エラーが発生する必要があります。問題は、終了するように指示された場合、Excel を開いたままにし、コードを処理するための参照を維持する理由です。

編集 - 試していません。OPコードから適応しただけです。必要に応じて適応

Option Explicit

    ResaveFiles "Word.Application", "docx", 12, 0
    ResaveFiles "Excel.Application", "xlsx", 51, 56

MsgBox "All done."


Sub ResaveFiles(progID, srcExtName, srcExtNum, tmpExtNum )
Dim app, doc
Dim fso, objFile, objOpenFile, strDirectory

    Set fso = CreateObject("Scripting.FileSystemObject")
    For Each objFile in fso.GetFolder( "." ).Files
        If LCase(fso.GetExtensionName( objFile.Name )) = srcExtName Then

            ' Get references
            Set app = GetNewAppInstance( progID )
            Set doc = GetDocumentHandler( app )

            ' Save temp
            Set objOpenFile = doc.Open( objFile.Path )
            strDirectory = fso.BuildPath( objOpenFile.path, fso.GetBaseName(objOpenFile.name) & "._temp" )
            objOpenFile.SaveAs strDirectory, tmpExtNum
            objOpenFile.Close

            ' Release objects
            Set objOpenFile = nothing 
            Set doc = nothing 
            app.Quit
            Set app = nothing

            ' Get references again
            Set app = GetNewAppInstance( progID )
            Set doc = GetDocumentHandler( app )

            ' Resave file
            Set objOpenFile = doc.Open( strDirectory )
            objOpenFile.SaveAs objFile.path, srcExtNum
            objOpenFile.Close

            ' Release objects
            Set objOpenFile = nothing 
            Set doc = nothing 
            app.Quit
            Set app = nothing

            ' Clean
            fso.DeleteFile(strDirectory)

        End If
    Next 

End Sub


Function GetNewAppInstance( ByVal progID )
    Set GetNewAppInstance = CreateObject( progID )
    With GetNewAppInstance
        .Visible = False
        .DisplayAlerts = False
    End With
End Function

Function GetDocumentHandler( app )
    Dim name
    name = app.Name
    If InStr(name,"Excel") > 0 Then
        Set GetDocumentHandler = app.Workbooks
    ElseIf InStr(name,"Word") > 0 Then
        Set GetDocumentHandler = app.Documents
    Else
        Set GetDocumentHandler = app
    End If
End Function
于 2013-11-12T16:46:51.243 に答える