Converting multiple Visio shapes at once on/from MS Word document

[KentS]

I wrote the following routine to convert all the embedded Visio shapes on a MS Word document (.docx or .mhtml) to SVG files. It is ran from MS Word.

It works but is slow because it effectively closes and reopens a Visio instances between processing every shapes (of type=Visio). Is there a way to speed this up by not doing that? I have been unsuccessful so far.

Sub ExtractAndSaveEmbeddedFiles()
    Dim objEmbeddedShape As InlineShape
    Dim objShape As Object
    Dim shapeIdx As Integer
    Dim strShapeType As String, strEmbeddedDocName As String, svgFilePathName As String
    Dim objEmbeddedDoc As Object
    Dim svgIndex As Integer
    Dim typeCorrect  As Boolean
    Dim tempObj
    Dim AppVisio As Visio.Application
    ' export the non-inline shapes to svg files
    For Each objShape In ActiveDocument.InlineShapes
        With objShape
            shapeIdx = shapeIdx + 1
             If Not .OLEFormat Is Nothing Then
                 '  Find and open the embedded doc.
                 strShapeType = .OLEFormat.ClassType        
                 If InStr(1, strShapeType, "visio", vbTextCompare) Then
                    .Application.ScreenUpdating = False
                    .OLEFormat.Open  ' !!! this can take some time and adds up quickly in the loop       
                    '  Initialization
                    Set objEmbeddedDoc = .OLEFormat.Object        
                    ' make sure Type property exists
                    On Error Resume Next
                    typeCorrect = False
                    tempObj = objEmbeddedDoc.Type
                    typeCorrect = (Err = 0) And tempObj = 1 '1 is visio object
                    On Error GoTo 0
                    If typeCorrect Then
                        '  Export embedded file to .svg
                        svgFilePathName = "c:\temp2\visioDrawing" & Format(shapeIdx, "000") & ".svg"
                        objEmbeddedDoc.Application.Settings.SVGExportFormat = visSVGIncludeVisioElements
                        objEmbeddedDoc.Application.ActivePage.Export (svgFilePathName)
                    End If                       
                    ' clean up
                    On Error Resume Next
                    objEmbeddedDoc.Close
                    Set objEmbeddedDoc = Nothing
                    On Error GoTo 0
                End If 
                ' InStr(1, strShapeType, "visio", vbTextCompare)
            End If 'Not .OLEFormat Is Nothing Then
        End With 'objEmbeddedShape
    Next 'objEmbeddedShape        
    ' ditto with ActiveDocument.Shapes, equations, ...
End Sub

Thanks,

-Kent