VBA代码提取Word文档中的Visio附图：解决运行时类型不匹配错误

这篇文章将介绍如何使用VBA代码从Word文档中提取Visio附图，并解决运行时类型不匹配错误。

代码示例：

Public Sub ExtractDrawings(control As Office.IRibbonControl)
    Dim FileDialog As FileDialog
    Dim SelectedFiles As Variant
    Dim FileName As Variant
    Dim WordDocument As Document
    Dim InlineShape As InlineShape
    Dim FolderPath As String
    Dim NewFolderPath As String
    Dim FileExtension As String
    Dim FilePathArray() As String
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    ' 创建一个文件对话框以选择Word文档
    Set FileDialog = Application.FileDialog(msoFileDialogOpen)
    With FileDialog
        .AllowMultiSelect = True
        .Title = '请选择要提取附图的Word文档'
        .Filters.Clear
        .Filters.Add 'Word Documents', '*.docx; *.doc'
        
        ' 显示文件对话框并存储选定的文件
        If .Show = -1 Then
            SelectedFiles = FileDialog.SelectedItems
            ReDim FilePathArray(1 To SelectedFiles.Count)
            For i = 1 To SelectedFiles.Count
                FilePathArray(i) = SelectedFiles(i) & '\'
            Next i
        Else
            Exit Sub
        End If
    End With
    
    ' 检查是否选择了任何文件
    If IsEmpty(SelectedFiles) Then
        MsgBox '没有选择任何文件！'
        Exit Sub
    End If
    
    ' 循环遍历选定的文件
    For Each FileName In FilePathArray
        ' 打开Word文档
        Set WordDocument = Documents.Open(FileName)
        
        ' 创建一个新的文件夹以存放提取的图像
        FolderPath = WordDocument.path
        NewFolderPath = FolderPath & '\' & WordDocument.Name & '_提取附图'
        CreateFolder NewFolderPath
        
        ' 循环遍历文档中的内嵌形状
        For Each InlineShape In WordDocument.InlineShapes
            ' 检查内嵌形状是否为嵌入的Visio文件
            If InlineShape.Type = wdInlineShapeEmbeddedOLEObject Then
                If InlineShape.OLEFormat.ProgID = 'Visio.Drawing.11' Or InlineShape.OLEFormat.ProgID = 'Visio.Drawing.15' Then
                    ' 获取适当的文件扩展名
                    If InlineShape.OLEFormat.ProgID = 'Visio.Drawing.11' Then
                        FileExtension = '.vsd'
                    ElseIf InlineShape.OLEFormat.ProgID = 'Visio.Drawing.15' Then
                        FileExtension = '.vsdx'
                    End If
                    
                    ' 将Visio文件保存到新文件夹
                    InlineShape.OLEFormat.Object.SaveAs NewFolderPath & '\' & InlineShape.Range.Paragraphs(1).Range.text & FileExtension
                End If
            End If
        Next InlineShape
        
        ' 关闭Word文档
        WordDocument.Close SaveChanges:=wdDoNotSaveChanges
    Next FileName
    
    MsgBox '附图已提取完毕！'
End Sub

Sub CreateFolder(FolderPath As String)
    Dim FileSystem As Object
    Set FileSystem = CreateObject('Scripting.FileSystemObject')
    If Not FileSystem.FolderExists(FolderPath) Then
        FileSystem.CreateFolder FolderPath
    End If
End Sub

解释：

运行时类型不匹配错误的原因是，SelectedFiles 是一个 Variant 类型的数组，而 For Each 循环默认是对数组中每个元素进行循环。为了解决这个问题，代码中将 SelectedFiles 中的文件路径转换为字符串数组 FilePathArray，然后使用 For Each 循环遍历该数组。
代码首先创建一个文件对话框，允许用户选择多个Word文档。
然后，代码循环遍历每个选定的Word文档，并将文档中的内嵌形状提取到一个新的文件夹中。
最后，代码使用 CreateFolder 子过程创建提取的图像的文件夹。

注意：

该代码仅适用于嵌入的Visio文件。
该代码使用 InlineShape.Range.Paragraphs(1).Range.text 获取文件名，如果该文本为空，则可以使用其他方法获取文件名。

希望本文能够帮助您使用VBA代码提取Word文档中的Visio附图，并解决运行时类型不匹配错误。