Search code examples
vbscriptms-officetypename

Excel and Word behaving difrerently in the same code


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.


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