Speichern Sie eingebettete PDFs in Word-Datei

Question

Ich brauche ein VBA-Makro für MS Word 2013, um die eingebetteten PDF-Anlagen in der Word-Datei in einem Ordner zu speichern.

Ich habe eine funktionierende Lösung in Excel gefunden, die eingebettete Dateien im Excel-Dokument speichert. Ich habe einige Änderungen an Word VBA vorgenommen, aber es funktionieren keine Ideen, damit es in Word funktioniert.

Private Declare PtrSafe Function CloseClipboard Lib "user32"() As Long 
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long 
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long 
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long 
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long 
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long 
Private Declare PtrSafe Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long) 

Sub Embed_Files_Save_PDF_Run() 
For Each file In ThisDocument.InlineShapes 
Call Embed_Files_Save_PDF(file) 
Next 
End Sub 

Sub Embed_Files_Save_PDF(ByVal Embedded_PDF) 

     On Error Resume Next 

     Dim PDF_Path As String 
     PDF_Path = ActiveDocument.Path 

     If Right$(PDF_Path, 1) <> Application.PathSeparator Then PDF_Path = PDF_Path & Application.PathSeparator 

     Dim PDF_Name As String 
     PDF_Name = UCase$(Left$(Embedded_PDF.OLEFormat.IconLabel, 1)) & Mid$(Embedded_PDF.OLEFormat.IconLabel, 2)  
     PDF_Name = PDF_Name & ".PDF" 

     Dim FileEOF As Long 
     Dim FileLOF As Long 
     Dim CB_Lock As Long   ' ClipBoard Lock 
     Dim CB_Size As Long   ' ClibBoard Size 
     Dim PDF_File() As Byte 
     Dim Temp_PDF() As Byte 

     Embedded_PDF.Copy 
     If OpenClipboard(0) Then 
      Counter = GetClipboardData(49156) 
      If Counter <> 0 Then CB_Size = GlobalSize(Counter) 
      If CB_Size <> 0 Then CB_Lock = GlobalLock(Counter) 
      If CB_Lock <> 0 Then 
        ReDim Temp_PDF(1 To CLng(CB_Size)) 
        RtlMoveMemory Temp_PDF(1), ByVal CB_Lock, CB_Size 
        Call GlobalUnlock(Counter) 
        Counter = InStrB(Temp_PDF, StrConv("%PDF", vbFromUnicode)) 
        If Counter > 0 Then 
         FileEOF = InStrB(Counter, Temp_PDF, StrConv("%%EOF", vbFromUnicode)) 
         While FileEOF 
           FileLOF = FileEOF - Counter + 7 
           FileEOF = InStrB(FileEOF + 5, Temp_PDF, StrConv("%%EOF", vbFromUnicode)) 
         Wend 

         ReDim PDF_File(1 To FileLOF) 
         For FileEOF = 1 To FileLOF 
           PDF_File(FileEOF) = Temp_PDF(Counter + FileEOF - 1) 
         Next 
        End If 
      End If 
      CloseClipboard 
      If Counter > 0 Then 
        Counter = FreeFile 
        Open PDF_Path & PDF_Name For Binary As #Counter 
         Put #Counter, 1, PDF_File 
        Close #Counter 
      End If 
     End If 

     Set Embedded_PDF = Nothing 

End Sub 

Jede Hilfe wäre willkommen.

Answer 1

versuchen diese

es nicht die pdf-Datei nicht speichern, aber es öffnet es in Acrobat, so dass Sie es

Sub pdfExtract() 

    ' opens embedded pdf file in acrobat reader for saving 

    Dim shap As InlineShape 

    For Each shap In ActiveDocument.InlineShapes 
     If Not shap.OLEFormat Is Nothing Then 
      If shap.OLEFormat.ClassType = "AcroExch.Document.DC" Then 
       shap.OLEFormat.DoVerb wdOLEVerbOpen 
      End If 
     End If 
    Next shap 
End Sub