將嵌入式PDF保存在Word文件中

Question

我需要MS Word 2013的VBA宏來將嵌入式PDF附件保存在Word文件中的文件夾中。

我在Excel中找到了一個可以在Excel文檔中保存嵌入文件的工作解決方案，我已經對Word VBA中的工作進行了一些修改，但是它沒有任何創意使它在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 

任何幫助，將不勝感激。

Answer 1

試試這個

它不保存的PDF文件，但它會打開它在Acrobat，這樣就可以將其保存

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