Save embedded PDFs in Word file - vba

Question

I need a VBA macro for MS Word 2013 to save the embedded PDF attachments in the Word file into a folder.
I found a working solution in Excel which saves embedded files in the Excel document, I have made some modifications to work in Word VBA, but it doesn't work any ideas to make it work in 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
Any help would be appreciated.

Answer 1

try this
it does not save the pdf file but it opens it in acrobat so that you can save it
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