Public Sub ExtractDrawingscontrol As OfficeIRibbonControl Dim FileDialog As FileDialog Dim SelectedFiles As Variant Dim FileName As Variant Dim WordDocument As Document Dim InlineS

可能是因为SelectedFiles是一个Variant类型的数组，而For Each循环默认是对数组中每个元素进行循环。解决方法是将SelectedFiles中的文件路径转换为字符串数组，然后再进行循环。可以尝试修改代码如下：

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

' Create a file dialog to select Word documents
Set FileDialog = Application.FileDialog(msoFileDialogOpen)
With FileDialog
    .AllowMultiSelect = True
    .Title = "请选择要提取附图的Word文档"
    .Filters.Clear
    .Filters.Add "Word Documents", "*.docx; *.doc"
    
    ' Show the file dialog and store the selected files
    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

' Check if any files were selected
If IsEmpty(SelectedFiles) Then
    MsgBox "没有选择任何文件！"
    Exit Sub
End If

' Loop through the selected files
For Each FileName In FilePathArray
    ' Open the Word document
    Set WordDocument = Documents.Open(FileName)
    
    ' Create a new folder for the extracted images
    FolderPath = WordDocument.path
    NewFolderPath = FolderPath & "\" & WordDocument.Name & "_提取附图"
    CreateFolder NewFolderPath
    
    ' Loop through the inline shapes in the document
    For Each InlineShape In WordDocument.InlineShapes
        ' Check if the inline shape is an embedded Visio file
        If InlineShape.Type = wdInlineShapeEmbeddedOLEObject Then
            If InlineShape.OLEFormat.ProgID = "Visio.Drawing.11" Or InlineShape.OLEFormat.ProgID = "Visio.Drawing.15" Then
                ' Get the appropriate file extension
                If InlineShape.OLEFormat.ProgID = "Visio.Drawing.11" Then
                    FileExtension = ".vsd"
                ElseIf InlineShape.OLEFormat.ProgID = "Visio.Drawing.15" Then
                    FileExtension = ".vsdx"
                End If
                
                ' Save the Visio file to the new folder
                InlineShape.OLEFormat.Object.SaveAs NewFolderPath & "\" & InlineShape.Range.Paragraphs(1).Range.text & FileExtension
            End If
        End If
    Next InlineShape
    
    ' Close the Word document
    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