I found this code from an early post. It prints to adobe perfectly and it saves to the path i have suggested. the only thing is...when it gets to this section of the code..it pops open a website. Does anyone have any thoughts to fix?
the whole code and the original posting
http://www.mrexcel.com/forum/showthread.php?t=115191
Code:
WS.Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDF995"
the whole code and the original posting
http://www.mrexcel.com/forum/showthread.php?t=115191
Code:
'Needed to Read INI file settings
Declare Function GetPrivateProfileString Lib "kernel32" Alias _
"GetPrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
'Needed to Write INI file settings
Declare Function WritePrivateProfileString Lib "kernel32" Alias _
"WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub SheetToPDF(WS As Worksheet, OutputFile As String)
' This subroutine will print a worksheet to a PDF file using PDF995, a free utility
' to generate PDF files. Download it at www.pdf995.com
' Two arguments must be passed into this routine
' 1. WS - A worksheet pointer
' 2. OutputFile - The full path and name of the desired pdf file
' Be sure to check that the "Generating PDF CS" setting in pdfsync.ini is set to 0
' when pdf995 is idle. This codes uses that as a completion flag as it seems to be
' the most reliable indication that PDF995 is done writing the pdf file.
Dim syncfile As String, maxwaittime As Long
Dim iniFileName As String 'tmpPrinter As Printer
Dim x As Long
Dim tmpoutputfile As String, tmpAutoLaunch As String
' set the location of the PDF995.ini and the pdfsync files
iniFileName = "c:\pdf995\res\pdf995.ini"
syncfile = "c:\pdf995\res\pdfsync.ini"
' save current settings from the PDF995.ini file
tmpoutputfile = ReadINIfile("PARAMETERS", "Output File", iniFileName)
tmpAutoLaunch = ReadINIfile("PARAMETERS", "Autolaunch", iniFileName)
' remove previous pdf if it exists
On Error Resume Next
Kill OutputFile
On Error GoTo Cleanup
' setup new values in PDF995.ini
x = WritePrivateProfileString("PARAMETERS", "Output File", OutputFile, iniFileName)
x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", "0", iniFileName)
'print the worksheet
WS.Select
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:="PDF995"
' PDF995 operates asynchronously. We need to determine when it is done so we can
' continue. This is done by checking the "Generating PDF CS" parameter in the pdfsync.ini
' file. A loop with a 2 second delay is used to determine when it is finished.
Sleep (2000) ' pause 2 seconds (1000 = 1 sec)
maxwaittime = 60000 'If pdf995 isn't done in 60 seconds, quit anyway
Do While ReadINIfile("PARAMETERS", "Generating PDF CS", syncfile) = "1" And maxwaittime > 0
Sleep (2000) ' pause 2 seconds and re-check the status
maxwaittime = maxwaittime - 2000
Loop
' restore the original default printer and the PDF995.ini settings
Cleanup:
x = WritePrivateProfileString("PARAMETERS", "Output File", tmpoutputfile, iniFileName)
x = WritePrivateProfileString("PARAMETERS", "AutoLaunch", tmpAutoLaunch, iniFileName)
x = WritePrivateProfileString("PARAMETERS", "Launch", "", iniFileName)
On Error Resume Next
End Sub
Function ReadINIfile(sSection As String, sEntry As String, sFilename As String) As String
Dim x As Long
Dim sDefault As String
Dim sRetBuf As String, iLenBuf As Integer
Dim sValue As String
'Six arguments
'Explanation of arguments:
'sSection: ini file section (always between brackets)
'sEntry : word on left side of "=" sign
'sDefault$: value returned if function is unsuccessful
'sRetBuf$ : the value you're looking for will be copied to this buffer string
'iLenBuf% : Length in characters of the buffer string
'sFileName: Path to the ini file
sDefault$ = ""
sRetBuf$ = String$(256, 0) '256 null characters
iLenBuf% = Len(sRetBuf$)
x = GetPrivateProfileString(sSection, sEntry, _
sDefault$, sRetBuf$, iLenBuf%, sFilename)
ReadINIfile = Left$(sRetBuf$, x)
End Function
Sub PrintToPDF()
' This example prints the first sheet of the workbook. It calls the SheetToPDF subroutine,
' passing it the worksheet pointer, and the PDFFileName (the worksheet name + .pdf)
Dim PDFFileName As String
PDFFileName = "S:\USA-HOUSTON\CPDS\GT FAMM\IctsOnline\Global Trading\Risk Control\Updates for Internal Prices\U.S. Daily FPC\" & Sheets(1).Name & ".pdf"
Call SheetToPDF(Sheets(1), PDFFileName)
End Sub
Sub PrintCPSheets()
' This example prints specific named worksheets. It calls the SheetToPDF subroutine one
' time for each sheet, passing it a worksheet pointer, and PDFFileName.
Dim CS As Worksheet
Dim PDFFileName As String
CurrentPath = "c:\temp\"
Set CS = Sheets("West")
PDFFileName = CurrentPath & CS.Name & ".pdf"
Call SheetToPDF(CS, PDFFileName)
Set CS = Sheets("Northeast")
PDFFileName = CurrentPath & CS.Name & ".pdf"
Call SheetToPDF(CS, PDFFileName)
Set CS = Sheets("Northeast")
PDFFileName = CurrentPath & CS.Name & ".pdf"
Call SheetToPDF(CS, PDFFileName)
Set CS = Sheets("Southeast")
PDFFileName = CurrentPath & CS.Name & ".pdf"
Call SheetToPDF(CS, PDFFileName)
Set CS = Sheets("Central")
PDFFileName = CurrentPath & CS.Name & ".pdf"
Call SheetToPDF(CS, PDFFileName)
End Sub