Need to Print Embedded PDFs

K

kmackie1

New Member
Joined
Jul 30, 2013
Messages
14
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!
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Sort by date Sort by votes
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!
 
Upvote 0
Re: Need to Print Embedded PDFs - PLEASE HELP :(

Hi & welcome to MrExcel!
Try this:
Rich (BB code): 
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
 
Upvote 0
Re: Need to Print Embedded PDFs - PLEASE HELP :(

This prints all PDFs embedded into the active sheet:
Rich (BB code): 
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
 
Last edited:
Upvote 0
Re: Need to Print Embedded PDFs - PLEASE HELP :(

ZVI said:
Hi & welcome to MrExcel!
Try this:
Rich (BB code): 
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
Click to expand...


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
Click to expand...

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.
 
Upvote 0
Re: Need to Print Embedded PDFs - PLEASE HELP :(

kmackie1 said:
Compile Error: Can't Find Project or Library
Click to expand...
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?
 
Last edited:
Upvote 0
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
Click to expand...

Soooo close! I can taste it! Thanks again for your help!
 
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Question Question
Using VBA to retrieve specific pages from PDFs
Replies
1
Views
69
Big_Al_fae_the_rigs
B
O
  • Question Question
Convert a bulk of PDFs into different text files (same names)
Replies
0
Views
559
Oxirrinko
O
kelly mort
  • Solved
VBA Code to close an opened pdf amendment needed
2
Replies
11
Views
3K
mugginsjr
M
H
  • Question Question
Macro: Convert pdf into Excel and extract certain data to put together with file name
Replies
1
Views
3K
HeinrichPaul
H
R
  • Question Question
Paste Method Failed on PDF to Excel
Replies
2
Views
972
rex759
R

Forum statistics

Threads
1,223,664
Messages
6,173,654
Members
452,525
Latest member
DPOLKADOT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top