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

 

[ZVI]

just not sure what to do with this

Option Explicit

#If VBA7 Then
...
#Else
...
#End If

Move it to the top of a code module

 

[skacutter]

results in "Only comments may appear after end sub, end function or end property" no matter where i Put this

 

[skacutter]

Sub save_Form()


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
Revision_Type_Selector.Show






End Sub
 
Private 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 = "Rev_Man"                                        ' Name or index of the sheet with embedded PDF
  Const OLE = "Object 2"                              ' Name or index of the PDF OleObject
  Const FileName = "C:\Matrix Auto Forms\P053220xxxxxxxxxxxxxxxx.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

 

[ZVI]

Below is the layout of the code and how to call it from your Sub save_Form()

Option Explicit ' <--- This is the 1st code line in the code MODULE, but not inside of any Sub of Function code. This code line is optional.
 
' API declaration have to be on the top of the CODE MODULE, but  not inside of any Sub or Function
#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()
 
  ' ...
 
End Sub
 
' ==========================
' Put your (Form's) code here:
 
Sub save_Form()
  Call JsoWithEmbeddedPdf_01
End Sub

 

[skacutter]

Yes I have this all worked out now. It works as advertised

Thank You
Chris

 

[ZVI]

Glad you got it all sorted, Chris!
Have a great week-end!