How to remove a PDF Object that is embedded in excel

[abowers]

I have a pdf form attached to a spreadsheet. Currently I am able to grab a pdf from the computer within vba, add user submitted text and other things and place it into the pdf and then save it in a new location. This program will be placed on multiple computers. I want the excel file to host this pdf and then be able to extract it from a worksheet, edit it with the submitted text and then save it to a harddrive location. Any ideas??

currently this is what I have.

Public Sub CommandButton6_Click()
Dim RevReqDate As String
RevReqDate = Date


'Check if output directory exists and if not create it


If Len(Dir("c:\Matrix Auto Forms", vbDirectory)) = 0 Then
MkDir "c:\Matrix Auto Forms"
End If




Dim FileNm, gApp, avDoc, pdDoc, jso




If OptionButton2.Enabled Then
FileNm = c:\Matrix Auto Forms\P053220 'Maintenance Form ' I want this to be the document attached to spreadsheet 4 (its called object1 in excel)
Else
FileNm = "c:\Matrix Auto Forms\P053220-222.pdf" 'Operations Form 'This will be another document attached to spreadsheet 4


End If


OutFileName = "C:\Matrix Auto Forms\P053220" & "_" & ComboBox1.Value & "_" & TextBox5.Text & ".pdf"
Set gApp = CreateObject("AcroExch.app")


Set avDoc = CreateObject("AcroExch.AVDoc")
If avDoc.Open(FileNm, "") Then
Set pdDoc = avDoc.GetPDDoc()
Set jso = pdDoc.GetJSObject


jso.getField("topmostSubform[0].Page1[0].EmployeeName[0]").Value = TextBox11.Text
jso.getField("topmostSubform[0].Page1[0].EmployeeNum[0]").Value = TextBox12.Text
jso.getField("topmostSubform[0].Page1[0].Station[0]").Value = TextBox13.Text
jso.getField("topmostSubform[0].Page1[0].Dept[0]").Value = TextBox14.Text
jso.getField("topmostSubform[0].Page1[0].TextField1[0]").Value = TextBox15.Text
jso.getField("topmostSubform[0].Page1[0].Requestdate[0]").Value = RevReqDate
jso.getField("topmostSubform[0].Page1[0].ManualName[0]").Value = ComboBox1.Value
jso.getField("topmostSubform[0].Page1[0].Chap-sec-sub[0]").Value = ListBox3.List(i)
jso.getField("topmostSubform[0].Page1[0].Discription[0]").Value = " ." & ListBox3.List(i, 2)

jso.flattenPages = 1
pdDoc.Save 1, OutFileName 'Save changes as new PDF
pdDoc.Close
End If


'Close the PDF; the True parameter prevents the Save As dialog from showing
avDoc.Close (True)


'Some cleaning
Set gApp = Nothing
Set avDoc = Nothing
Set pdDoc = Nothing
Set jso = Nothing


End Sub

 

[abowers]

Also try debugging step by step via F8 key.
Or try this code with 3 seconds waiting for a complete document loading:

  Set avDoc = CreateObject("AcroExch.App").GetActiveDoc
 
  '--> Wait a bit
  Dim t As Single
  t = Timer + 3
  While Timer < t: DoEvents: Wend
  '<--
 
  Set pdDoc = avDoc.GetPDDoc

------------------------------------------------------------------------------------------------------
I tried the timer. It didn't do anything it still caused the error.
The original code did work. I just had no way of saving the embedded file from the excel file.
At this point I'm kinda lost with what is throwing this error.

 

[abowers]

' --> Settings, change to suit
Const SH = 1 ' Name or index of the sheet with embedded PDF
Const OLE = "Object 1" ' Name or index of the PDF OleObject
Const FN = "P053220-222.pdf" ' Filename of the PDF
'<-- End of the settings

Dim avDoc As Object 'As AcroAVDoc
Dim pdDoc As Object 'As AcroPDDoc
Dim jso As Object

Sheets(SH).OLEObjects(OLE).Activate '<-- This opens the embedded PDF in Acrobat application

Set avDoc = CreateObject("AcroExch.App").GetActiveDoc
Set pdDoc = avDoc.GetPDDoc
Set jso = pdDoc.GetJSObject



When looking at the code and seeing what values and such its finding.

"Set pdDoc = av.Doc.GetPDDoc" is coming back with no value.. as it is not able to find the value properly from line above it...



As stated previously the "Sheets(SH) ....... " line activates the file .. but it doesn't seem that avDoc =Create Object is not grabbing the active Object.

 

[ZVI]

Saving of an embedded PDF file to a folder is possible with some API code.
But please try firstly the replacing of this code line: Sheets(SH).OLEObjects(OLE).Activate
by that one: Sheets(SH).OLEObjects(OLE).Verb xlOpen

 

[ZVI]

The below code saves the embedded PDF object to the folder, then opens it in Adobe Acrobat application for the modification and saving.
Don't bother about a lot of API code, in my testings it is working in both 32 or 64bit versions of Excel.

Option Explicit
 
#If VBA7 Then
  Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
  Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
  Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
  Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
  Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
  Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
  Dim hWnd As LongPtr, Size As LongPtr, Ptr As LongPtr
#Else
  Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
  Private Declare Function CloseClipboard Lib "user32" () As Long
  Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
  Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
  Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  Dim hWnd As Long, Size As Long, Ptr As Long
#End If
 
Sub JsoWithEmbeddedPdf_01()
'ZVI:2017-01-31 https://www.mrexcel.com/forum/excel-questions/988452-how-remove-pdf-object-embedded-excel.html#post4743477
 
  ' --> Settings, change to suit
  Const SH = 4                                        ' Name or index of the sheet with embedded PDF
  Const OLE = "Object 1"                              ' Name or index of the PDF OleObject
  Const FileName = "C:\Matrix Auto Forms\P053220.pdf" ' Filename of the PDF
  '<-- End of the settings
 
  Dim avDoc As Object 'As AcroAVDoc
  Dim pdDoc As Object 'As AcroPDDoc
  Dim jso As Object
  Dim obj As OLEObject
  Dim a() As Byte, b() As Byte, i As Long, j As Long, k As Long
  Dim FN As Integer
 
  On Error GoTo exit_
 
  Set obj = Sheets(SH).OLEObjects(OLE)
  If Not obj.progID Like "Acro*.Document*" Or obj.OLEType <> 1 Then
    MsgBox "PDF OleObject not found", vbExclamation, "Exit"
    Exit Sub
  End If
 
  With CreateObject("AcroExch.App")
    obj.Copy
    If OpenClipboard(0) Then
      hWnd = GetClipboardData(49156)
      If hWnd Then Size = GlobalSize(hWnd)
      If Size Then Ptr = GlobalLock(hWnd)
      If Ptr Then
        ReDim a(1 To CLng(Size))
        CopyMemory a(1), ByVal Ptr, Size
        Call GlobalUnlock(hWnd)
        i = InStrB(a, StrConv("%PDF", vbFromUnicode))
        If i Then
          k = InStrB(i, a, StrConv("%%EOF", vbFromUnicode)) ' - i + 7
          While k
            j = k - i + 7
            k = InStrB(k + 5, a, StrConv("%%EOF", vbFromUnicode))
          Wend
          ReDim b(1 To j)
          For k = 1 To j
            b(k) = a(i + k - 1)
          Next
          Ptr = 0
        End If
      End If
      Application.CutCopyMode = False
      CloseClipboard
      If i Then
        If Len(Dir(FileName)) Then Kill FileName
        FN = FreeFile
        Open FileName For Binary As #FN
        Put #FN, , b
        Close #FN
        Set avDoc = CreateObject("AcroExch.AVDoc")
        avDoc.Open FileName, vbNullString
        Set pdDoc = avDoc.GetPDDoc()
        Set jso = pdDoc.GetJSObject
       
        ' The code for PDF form editing
'        With jso
'          .getField("topmostSubform[0].Page1[0].EmployeeName[0]").Value = TextBox11.Text
'          .getField("topmostSubform[0].Page1[0].EmployeeNum[0]").Value = TextBox12.Text
'          .getField("topmostSubform[0].Page1[0].Station[0]").Value = TextBox13.Text
'          .getField("topmostSubform[0].Page1[0].Dept[0]").Value = TextBox14.Text
'          .getField("topmostSubform[0].Page1[0].TextField1[0]").Value = TextBox15.Text
'          .getField("topmostSubform[0].Page1[0].Requestdate[0]").Value = RevReqDate
'          .getField("topmostSubform[0].Page1[0].ManualName[0]").Value = ComboBox1.Value
'          .getField("topmostSubform[0].Page1[0].Chap-sec-sub[0]").Value = ListBox3.List(i)
'          .getField("topmostSubform[0].Page1[0].Discription[0]").Value = " ." & ListBox3.List(i, 2)
'          .flattenPages = 1
'        End With
 
        ' Save and close PDF file
        pdDoc.Save 1, FileName
        avDoc.Close True
      Else
        MsgBox "PDF format is corrupted", vbExclamation, "Exit"
        Exit Sub
      End If
    Else
      Application.CutCopyMode = False
      MsgBox "Can't copy the OleObject '" & obj.Name & "' to the clipboard", vbCritical, "Exit"
      Exit Sub
    End If
    .Exit
  End With
 
  ' Show the amount of embedded PDFs being printed
  MsgBox "File is saved as:" & vbLf & FileName, vbInformation, "Success!"
 
exit_:
 
  ' Release the memory of all object variables
  Set jso = Nothing
  Set pdDoc = Nothing
  Set avDoc = Nothing
 
  If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number
 
End Sub

 

[ZVI]

"Set pdDoc = av.Doc.GetPDDoc" is coming back with no value.. as it is not able to find the value properly from line above it...

Hope it's your typo, but av.Doc is wrong , should be avDoc without dot symbol.
And you can't see any properties of the acrobat object variables because all of them are hidden by IDispatch interface.

 

[abowers]

The extra "." was just a type I wrote writing in response to you. How do you implement a API Call? Never have worked with them either. I really appreciate all your help with this!

 

[ZVI]

Just copy all the code of post #14, then in your workbook hit Alf-F11 to open VBE and in the menu 'Insert' choose 'Module'.
Then paste the code. That's all. Run subroutine JsoWithEmbeddedPdf_01 to test before of any modifications.
Note: delete the duplicate of Option Explicit declaration in the top of the Module if happens

 

[skacutter]

Just copy all the code of post #14, then in your workbook hit Alf-F11 to open VBE and in the menu 'Insert' choose 'Module'.
Then paste the code. That's all. Run subroutine JsoWithEmbeddedPdf_01 to test before of any modifications.
Note: delete the duplicate of Option Explicit declaration in the top of the Module if happens

i need this in an existing macro. are you saying I should paste the code to the macro wrapper (module 1) then call it from inside my form code?

 

[skacutter]

just not sure what to do with this

Option Explicit

#If VBA7 Then
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As LongPtr
Private Declare PtrSafe Function GlobalSize Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
Dim hWnd As LongPtr, Size As LongPtr, Ptr As LongPtr
#Else
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Dim hWnd As Long, Size As Long, Ptr As Long
#End If

 

[ZVI]

i need this in an existing macro. are you saying I should paste the code to the macro wrapper (module 1) then call it from inside my form code?

Yes. Or copy all the code to the Form's module, but API declarations should be on the top of the code module after Option Explicit.