Enregistrer des fichiers PDF incorporés dans un fichier Word

Question

J'ai besoin d'une macro VBA pour MS Word 2013 pour enregistrer les pièces jointes PDF incorporées dans le fichier Word dans un dossier.

J'ai trouvé une solution de travail dans Excel qui enregistre les fichiers incorporés dans le document Excel, j'ai fait quelques modifications pour travailler dans Word VBA, mais ça ne marche pas des idées pour le faire fonctionner dans Word?

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 

Toute aide serait appréciée.

Answer 1

essayer

ne sauvegarde pas le fichier pdf mais il ouvre en acrobate de sorte que vous pouvez l'enregistrer

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