Question

I have a problem - instances of Excel and Word behave differently in the same procedure. Have a look at the code. The idea there is to have a procedure that handles resaving files in excel and word in various format combinations.

The problem is that I notice that word and excel behave differently - the appWord and appExcel have different type names. At some point appWord is changed from Application to Object, which then makes it impossible to close it. I don't understand the differences in the behaviour, since the code applied to them is identical.

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

I have tested it in the following way (with two typename tests) - when there are word files available, first appWord is Application and appExcel is empty, then it changes to Object and appExcel stays Empty (in this case we get an error when the subprocedure ends at AppWord.Quit). When there are no word files, and the script is processing Excels, first appWord is Object and appExcel is Application, then appWord is still Object and appExcel is still Application - in this case there are no errors when the subprocedure ends, on the appExcel.Quit.

Was it helpful?

Solution

Maybe i'm wrong, just my opinion:

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

set objOpenFile = appType.Open(strDirectory)

appType is a reference to what appWord.Documents or appExcel.Workbooks are referencing before entering your ResaveFiles Sub, where you instantiate a new copy of 'Excel.Application' or 'Word.Application', and in each of the cases, you instruct the application TO QUIT. The question is not why in the case of word you got an error. From my point of view YOU SHOULD got an error. The question is why, if instructed to quit, excel keeps open and maintaining references to handle your code.

EDIT - And not tried. Just adapted from OP code. Adapt as needed

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
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top