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