word vba 宏批量提取全部附件 到指定文件夹

word vba 宏批量提取全部附件 到指定文件夹

#If VBA7 Then
'For 64-Bit MS Office
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
#Else
'For 32-Bit MS Office
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As Long)
#End If


Sub 导出内嵌文件()
    ' 导出的文件夹
    Dim 导出的文件夹 As String
    导出的文件夹 = "C:\Users\accou\Downloads\"
    Set 文档 = ActiveDocument
    
    For Each 嵌入对象 In 文档.InlineShapes
    
        Debug.Print "类型" & 嵌入对象.Type
    
        If 嵌入对象.Type = wdInlineShapeEmbeddedOLEObject Then
        
            类型 = 嵌入对象.OLEFormat.ClassType
            Debug.Print "输出 " & 类型
            
            If InStr(1, 类型, "Excel") > 0 Then
            
                嵌入对象.Select
                
                完整路径 = 导出的文件夹 & Rnd & "需求一览表.xlsx"
                
                
                嵌入对象.OLEFormat.Open
                Sleep (3000)
                
                Set Excel对象 = GetObject(, "Excel.Application")
    
                Excel对象.Workbooks(1).SaveAs 完整路径, 51
                Excel对象.Workbooks(1).Close savechanges:=False
                
                Sleep (1000)
                
            End If
            
        End If
    

    Next
End Sub