Question

我需要MS Word 2013的VBA宏将Word文件中的嵌入式PDF附件保存到文件夹中。

我在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

将嵌入的PDF保存在Word文件中

1 个答案: