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

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.

Code:

---

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