Need to Print Embedded PDFs

[kmackie1]

Here is my code so far:

Public Sub PrintPDFFiles()​

Const ADOBEPATH As String = "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe"​

Const FILE_PATH As String = "C:\Users\kmackie\Desktop\Sample\Test"​

Const FILE_EXT As String = "PDF"​

​

Dim fso, fld, file​

​

Set fso = CreateObject("Scripting.FileSystemObject")​

Set fld = fso.GetFolder(FILE_PATH)​

​

For Each file In fld.Files​

If UCase(Right(file.Name, 3)) = FILE_EXT Then​

Shell """" & ADOBEPATH & """/n /t """ & file.Path & """"​

End If​

Next​

End Sub
​

This code works perfectly for what I am trying to do... except for one thing:

I want to open and print PDFs that are already embedded into my worksheet. I can use the code to open the embedded PDF files:

ActiveSheet.Shapes("Object 1").OLEFormat.Activate​

How on earth can I just open these files and print them. I've spent so long trying to figure this out. If you can't tell... I'm a bit of a newbie.

End result:
I want to be able to click a button, have it open the embedded pdf file in Adobe Reader, Print it, Close Adobe Reader.
I will name my first born son to the man that can solve this problem for me!

 

[kmackie1]

Re: Need to Print Embedded PDFs - PLEASE HELP

Please Help!!!

 

[kmackie1]

Re: Need to Print Embedded PDFs - PLEASE HELP

Id be willing to paypal some $$$ for help in figuring this out. On my honor! I really need to figure this out!

 

[Wessie]

Re: Need to Print Embedded PDFs - PLEASE HELP

Hi

Please see if this doesn't help you.

If you can retrieve the path of the OLE object then you can order it to print.

Retrieve filename from a PDF OLE object - Microsoft Access / VBA

 

[ZVI]

Re: Need to Print Embedded PDFs - PLEASE HELP

Hi & welcome to MrExcel!
Try this:

Sub PrintEmbeddedPdf()
' ZVI:2013-08-01 http://www.mrexcel.com/forum/excel-questions/717204-need-print-embedded-pdfs-please-help.html
 
  Dim b() As Byte, i As Long, j As Long, k As Long
  Dim FN As Integer, f As String, p As Variant
 
  ' Copy OleObject
  With ActiveSheet.OLEObjects
    If .Count = 0 Then
      MsgBox "Embedded PDF not found", vbExclamation, "Nothing to print"
      Exit Sub
    End If
    If Not .Item(1).progID Like "Acro*.Document*" Or .Item(1).OLEType <> 1 Then
      MsgBox "Embedded object is not PDF", vbExclamation, "Nothing to print"
      Exit Sub
    End If
    .Copy
  End With
 
  ' Paste it as SHS file
  p = ActiveWorkbook.Path
  f = Dir(p & "\*.shs")
  If Len(f) Then Kill p & "\*.shs"
  CreateObject("Shell.Application").Namespace(p).Self.InvokeVerb "Paste"
  Application.CutCopyMode = False
  f = Dir(p & "\*.shs")
  If Len(f) Then
    f = p & "\" & f
  Else
    MsgBox "Can't save embedded object to " & vbLf & p, vbCritical, "Error"
    Exit Sub
  End If
 
  ' Trap other errors
  On Error GoTo exit_
 
  ' Copy *.shs to the byte array
  ReDim b(1 To FileLen(f))
  FN = FreeFile
  Open f For Binary As #FN
  Get #FN, 1, b
  Close #FN
  Kill f
 
  ' Find PDF start position and the PDF's file length
  i = InStrB(b, StrConv("%PDF", vbFromUnicode))
  j = InStrB(i, b, StrConv("%%EOF", vbFromUnicode)) - i + 7
 
  ' Copy the bytes of PDF to the top of b() and trim others
  For k = 1 To j
    b(k) = b(i + k - 1)
  Next
  ReDim Preserve b(1 To j)
 
  ' Copy b() to the temporary PDF file
  f = p & "\_printed_.pdf"
  FN = FreeFile
  Open f For Binary As #FN
  Put #FN, , b
  Close #FN
 
  ' Print the temporary PDF file synchronously by AcroRd32.exe and then delete it
  CreateObject("wscript.shell").Run "AcroRd32.exe /N /T """ & f & """", 0, True
  Kill f
   
exit_:
 
  If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number
   
End Sub

 

[ZVI]

Re: Need to Print Embedded PDFs - PLEASE HELP

This prints all PDFs embedded into the active sheet:

Sub PrintEmbeddedPDFs()
' ZVI:2013-08-01 http://www.mrexcel.com/forum/excel-questions/717204-need-print-embedded-pdfs-please-help.html
 
  Dim b() As Byte, i As Long, j As Long, k As Long, n As Long
  Dim FN As Integer, f As String, p As Variant, obj As OLEObject
 
  p = ActiveWorkbook.Path
 
  ' Check OleObjects presence
  With ActiveSheet.OLEObjects
    If .Count = 0 Then
      MsgBox "Embedded PDF not found", vbExclamation, "Nothing to print"
      Exit Sub
    End If
  End With
 
  ' Process all OleObject of the ActiveSheet
  For Each obj In ActiveSheet.OLEObjects
   
    If obj.progID Like "Acro*.Document*" And obj.OLEType = 1 Then
      n = n + 1
      ' Copy OleObject
      obj.Copy
      ' Paste it as SHS file
      f = Dir(p & "\*.shs")
      If Len(f) Then Kill p & "\*.shs"
      CreateObject("Shell.Application").Namespace(p).Self.InvokeVerb "Paste"
      Application.CutCopyMode = False
      f = Dir(p & "\*.shs")
      If Len(f) Then
        f = p & "\" & f
      Else
        MsgBox "Can't save embedded object to " & vbLf & p, vbCritical, "Error"
        Exit Sub
      End If
      ' Trap other errors
      On Error GoTo exit_
      ' Copy SHS file to the byte array
      ReDim b(1 To FileLen(f))
      FN = FreeFile
      Open f For Binary As #FN
      Get #FN, 1, b
      Close #FN
      Kill f
     
      ' Find PDF start position and the PDF's file length
      i = InStrB(b, StrConv("%PDF", vbFromUnicode))
      j = InStrB(i, b, StrConv("%%EOF", vbFromUnicode)) - i + 7
     
      ' Copy the bytes of PDF to the top of b() and trim other bytes
      For k = 1 To j
        b(k) = b(i + k - 1)
      Next
      ReDim Preserve b(1 To j)
     
      ' Copy b() to the temporary PDF file
      f = p & "\_printed_.pdf"
      If Len(Dir(f)) Then Kill f
      FN = FreeFile
      Open f For Binary As #FN
      Put #FN, , b
      Close #FN
     
      ' Print the temporary PDF file synchronously by AcroRd32.exe and then delete it
      CreateObject("wscript.shell").Run "AcroRd32.exe /N /T """ & f & """", 0, True
      Kill f
     
    End If
 
  Next
 
  ' Inform how many Embedded PDFs were printed
  MsgBox "Amount of the printed PDFs: " & n, vbInformation, "PrintEmbeddedPDFs"
   
exit_:
 
  If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number
 
End Sub

 

[kmackie1]

Re: Need to Print Embedded PDFs - PLEASE HELP

Hi & welcome to MrExcel!
Try this:

Sub PrintEmbeddedPdf()
' ZVI:2013-08-01 http://www.mrexcel.com/forum/excel-questions/717204-need-print-embedded-pdfs-please-help.html
 
  Dim b() As Byte, i As Long, j As Long, k As Long
  Dim FN As Integer, f As String, p As Variant
 
  ' Copy OleObject
  With ActiveSheet.OLEObjects
    If .Count = 0 Then
      MsgBox "Embedded PDF not found", vbExclamation, "Nothing to print"
      Exit Sub
    End If
    If Not .Item(1).progID Like "Acro*.Document*" Or .Item(1).OLEType <> 1 Then
      MsgBox "Embedded object is not PDF", vbExclamation, "Nothing to print"
      Exit Sub
    End If
    .Copy
  End With
 
  ' Paste it as SHS file
  p = ActiveWorkbook.Path
  f = Dir(p & "\*.shs")
  If Len(f) Then Kill p & "\*.shs"
  CreateObject("Shell.Application").Namespace(p).Self.InvokeVerb "Paste"
  Application.CutCopyMode = False
  f = Dir(p & "\*.shs")
  If Len(f) Then
    f = p & "\" & f
  Else
    MsgBox "Can't save embedded object to " & vbLf & p, vbCritical, "Error"
    Exit Sub
  End If
 
  ' Trap other errors
  On Error GoTo exit_
 
  ' Copy *.shs to the byte array
  ReDim b(1 To FileLen(f))
  FN = FreeFile
  Open f For Binary As #FN
  Get #FN, 1, b
  Close #FN
  Kill f
 
  ' Find PDF start position and the PDF's file length
  i = InStrB(b, StrConv("%PDF", vbFromUnicode))
  j = InStrB(i, b, StrConv("%%EOF", vbFromUnicode)) - i + 7
 
  ' Copy the bytes of PDF to the top of b() and trim others
  For k = 1 To j
    b(k) = b(i + k - 1)
  Next
  ReDim Preserve b(1 To j)
 
  ' Copy b() to the temporary PDF file
  f = p & "\_printed_.pdf"
  FN = FreeFile
  Open f For Binary As #FN
  Put #FN, , b
  Close #FN
 
  ' Print the temporary PDF file synchronously by AcroRd32.exe and then delete it
  CreateObject("wscript.shell").Run "AcroRd32.exe /N /T """ & f & """", 0, True
  Kill f
   
exit_:
 
  If Err Then MsgBox Err.Description, vbCritical, "Error #" & Err.Number
   
End Sub

Im trying really hard to figure this out. I got an error here:

' Find PDF start position and the PDF's file length
i = InStrB(b, StrConv("%PDF", vbFromUnicode))
j = InStrB(i, b, StrConv("%%EOF", vbFromUnicode)) - i + 7

Saying:

Compile Error: Can't Find Project or Library


Is this because I need to find out where the embedded PDFs are being stored? Thank you so much for trying to help me! I've been working on this night and day for a while now.

 

[ZVI]

Re: Need to Print Embedded PDFs - PLEASE HELP

Compile Error: Can't Find Project or Library

The reason of error is not in those code lines.
It's rather in missing reference(s)
Press Alt-F11, then in VBE menu use Tools - References
and in the list of references uncheck all items started with MISSING

Try also VBE - Debug - "Compile VBAProject" to find issues in another code subroutines.

What is Excel version by the way?

 

[kmackie1]

Re: Need to Print Embedded PDFs - PLEASE HELP

Ah! You're a genius! However now I'm getting:

Error: Can't save embedded object to C:\users\Mackie\Downloads

Soooo close! I can taste it! Thanks again for your help!

 

[kmackie1]

Re: Need to Print Embedded PDFs - PLEASE HELP

Excel 2007