View Single Post
  #86 (permalink)  
Old 05-22-09, 01:08
pkstormy pkstormy is offline
Moderator
 
Join Date: Dec 2004
Location: Madison, WI
Posts: 3,925
Excel to PDF code via MSAccess VBA

Taken from one of the posts in the MSAccess forums:

Below was created by garethdart (I posted it here because I thought it appropiate for the code bank.)

Excel to PDF using Access VBA
Post:
Excel to PDF using Access VBA

HI ST (StarTrekker),

Here is a mod of Ken Puls Excel code which runs as a MS Access function;

Give this a try and see what issues you come up with - I've found that PDF Driver a little temperemental but this might just be the machine I'm on at the moment.

You should consider this a starting point only and I will help to tidy it up but I'm going to be chocca for the next few days so anyone else is more than welcome to chip in if they wish!

It could do with some error trapping and a bit of polishing up but hope it gets you started.

Anyhow - give this a try and let me know whether it's what you were after.

Option Compare Database
Option Explicit

Public Function PrintToPDF_MultiSheet_Early(sPDFPath As String, sPDFName As String, strExcelPath As String, strRecipient As String, Optional strSubject As String = "Quotation", Optional strBody As String = "Dear Sirs,")

'Author : Ken Puls (Excelguru.ca | Tips and pointers for Excel and other MS Office applications)
'Macro Purpose: Print to PDF file using PDFCreator
' (Download from SourceForge.net: PDFCreator)
' Designed for early bind, set reference to PDFCreator

'12th May 2009 - Modifed as access function by Gareth Dart
'Creates an Outlook messsage and adds individual .PDFs of each worksheet
'Changed sPDFPath and sPDFName to function variables
'Also added strExcelPath, strRecipient
'Also strSubject and strBody as optional variables
'Dont forget to add references for Excel, pdfcreator and Outlook

'call PrintToPDF_MultiSheet_Early("c:\", "TESTpdf", "c:\xlsTest.xls", "someperson@domain.com", "Revised Quotation", "Dear Sirs,")

Dim pdfjob As PDFCreator.clsPDFCreator
Dim lSheet As Long

Dim strOriginalName As String
strOriginalName = sPDFName

'Variables for excel
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet

Set xlApp = New Excel.Application
Set xlWb = xlApp.Workbooks.Open(strExcelPath)

Dim olApp As Outlook.Application
Dim olMessage As Outlook.MailItem
Dim fsoTemp As FileSystemObject

Set olApp = New Outlook.Application
Set olMessage = olApp.CreateItem(olMailItem)

olMessage.Recipients.Add strRecipient
olMessage.Subject = strSubject
olMessage.Body = strBody

Set pdfjob = New PDFCreator.clsPDFCreator
sPDFPath = xlWb.Path & xlApp.PathSeparator

If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Function
End If

For lSheet = 1 To xlWb.Sheets.Count
'Check if worksheet is empty and skip if so
If Not IsEmpty(xlWb.ActiveSheet.UsedRange) Then
With pdfjob
'/// Change the output file name here! ///
sPDFName = strOriginalName & xlWb.Sheets(lSheet).Name & ".pdf"
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With

'Print the document to PDF
'Syntax changed
xlWb.Sheets(lSheet).PrintOut , , 1, 0, "PDFCreator"

'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop

End If
'Add the latest attachment to the Outlook message
olMessage.Attachments.Add (sPDFPath & sPDFName)
'Delete the temporary PDF
Kill (sPDFPath & sPDFName)

Next lSheet

pdfjob.cClose
Set pdfjob = Nothing

'Close workbook without saving changes, exit Excel then clear variables.
xlWb.Close False
xlApp.Quit
Set xlWs = Nothing
Set xlWb = Nothing
Set xlApp = Nothing

'Display the eMail and allow user to edit then send
olMessage.Display

'Clear variables
Set olApp = Nothing
Set olMessage = Nothing

End Function
__________________
Expert Database Programming
MSAccess since 1.0, SQL Server since 6.5, Visual Basic (5.0, 6.0)

Last edited by pkstormy; 09-07-09 at 01:47.
Reply With Quote