Link to home
Start Free TrialLog in
Avatar of Jiten_Kanani
Jiten_Kanani

asked on

How do i convert a lotus notes document into pdf?

Hi,

I want to convert a lotus notes document into pdf file.
ASKER CERTIFIED SOLUTION
Avatar of mbonaci
mbonaci
Flag of Croatia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Sjef Bosman
That's a very short question, but not one that is easily answered.

Is it for one document only, or multiple, and maybe more than once? On your PC, or on the server?

For accidental conversions, use http://www.pdf-creator.us/
That's probably not the best one.

Better look here: http://www.pdfforge.org/
Avatar of Jiten_Kanani
Jiten_Kanani

ASKER

I want this solution in lotus script.
If you answered my question you would've get LS code.
Here's the code from LotusRNext (link doesn't work anymore):

Name:   Converting an existing notes document into a pdf file
Rating:   n/a
Last Updated:   08/13/2003
Original Author:   Stephen P. Stoddard
Official Website:   Login to get the official information link
Categories:   Code Examples - LotusScript
Description:   Here is code that allows you to change the default printer by modifying the registry key, and convert an existing notes document into a pdf file by "printing" to the pdfwriter. Several portions of this code came from different docs in this forum, so I felt obligated to put it back once I got everything working together!

Comment I copied to my code library:
This is a great source to initiate the conversion from notes. I have tested it, when I call uidoc.print(1), it prompts me a "Save As" interface and type a name for it in order to proceed with the pdf conversion.
How do I do all these in background since I need to automate the conversion in batch processing?
In Acrobat, you have the option for a "silence" conversion. Try to read its help and convert the document to a default folder/filename and start from there
'Add 4 hidden fields on the form, all text, all editable. Call them ITPrint, CurPrinter, CurDriver, CurPort.
'Add an action button with the following parameters:

'Declarations:
Declare Sub Sleepx Lib "kernel32.dll" Alias "Sleep" (Byval milliseconds As Long)
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (Byval hwnd As Long, Byval lpOperation As String, Byval lpFile As String, Byval lpparameters As String, Byval lpDirectory As String, Byval nShowCmd As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendNotifyMessageA" (Byval hwnd As Long, Byval wMsg As Long, Byval wParam As Long, lparam As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (Byval hKey As Long, Byval lpSubKey As String, Byval ulOptions As Long, Byval samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (Byval hKey As Long) As Long 
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (Byval hKey As Long, Byval lpValueName As String, Byval lpReserved As Long, lpType As Long, Byval lpData As String, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (Byval hKey As Long, Byval lpSubKey As String, Byval Reserved As Long, Byval dwType As Long, Byval lpData As String, Byval cbData As Long) As Long
Declare Function SendMessageTimeout Lib "user32.dll" Alias "SendMessageTimeoutA" (Byval hwnd As Long, Byval msg As Long, Byval wparam As Long, Byval lparam As Long, Byval fuflags As Long, Byval utimeout As Long, lpdwresult As Long) As Long

'Click:
Sub Click(Source As Button)
	On Error Goto errhand 

	Dim ws As New notesuiworkspace
	Dim uidoc As notesuidocument
	Dim doc As notesdocument
	Dim maildoc As notesdocument
	Dim db As notesdatabase
	Dim session As New notessession

	Set db = session.currentdatabase
	Set uidoc = ws.currentdocument
	Set doc = uidoc.document

	' try to get the current default printer from the registry
	Print "Reading the default printer from the Registry."
	Dim printerstring As String
	Dim curprinter As String
	Dim curdriver As String
	Dim curport As String
	Dim passprinter As String
	Dim passdriver As String
	Dim passport As String
	Dim rightstr As String
	Dim retstring As String
	Dim pos As Integer
	Dim holdstring As String


	printerstring = CheckRegistry("", "", "", "query")

	' if the registry key can't be opened, exit the sub, otherwise, parse the current printer, driver, and port
	' or flag the error for later
	If printerstring = "SEVERE" Then
		Exit Sub
	Else
		If Not printerstring = "ERROR" Then
			' R5 only code
			'curprinter = Strleft(printerstring, ",")
			'rightstr = Strright(printerstring, ",")
			'curdriver = Strleft(rightstr, ",")
			'curport = Strrightback(printerstring, ",")
			' R4 and R5 code
			holdstring = printerstring
			pos = Instr(1,holdstring,",",5)
			If pos <> 0 Then
				curprinter = Mid(holdstring,1,pos-1)
				holdstring = Mid(holdstring, pos+1, 100)
				pos = Instr(1,holdstring,",",5)
				If pos <> 0 Then
					curdriver = Mid(holdstring,1,pos-1)
					holdstring = Mid(holdstring, pos+1, 100)
					curport = Trim(holdstring)
				End If
			End If
		Else
			curprinter = "ERROR"
			curdriver = "winspool"
			curport = "ERROR"
		End If
	End If

	' set the current default printer, driver, and port to the PDFWriter
	retstring = CheckRegistry("Acrobat PDFWriter", curdriver, "LPT1:", "set")

	' if the registry key can't be set, exit the sub, otherwise, continue with the script
	If retstring = "SEVERE" Then
		Exit Sub
	End If

	' notify windows apps that a registry change has occured
	Const WM_SETTINGCHANGE = &H1A
	Const HWND_BROADCAST = &HFFFF
	Const SMTO_NORMAL = 2

	Dim rc As Long
	Dim lpdwResult As Long
	rc = sendmessagetimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, 0&, SMTO_NORMAL, 3000&, lpdwResult)
	Call sleepx(500)

	' set the ITPrint field to "Y" - this lets the queryclose event know we were attempting to print the doc and
	' not just closing the document. Set all printer related temporary variables - these will be used to set the printer back when complete
	Call uidoc.FieldSetText ( "ITPrint", "Y" )
	Call uidoc.FieldSetText ( "CurPrinter", curprinter )
	Call uidoc.FieldSetText ( "CurDriver", curdriver )
	Call uidoc.FieldSetText ( "CurPort", curport )

	Call uidoc.save

	' even if the system broadcast is successful, Notes doesn't recognize the printer switch until a new event is triggered. Close
	' the doc to trigger a new event. Other windows apps - such as Adobe, Netscape, and Word
	' immediately recognize the printer change after the broadcast is sent - even if they are already open.
	Call uidoc.close

	Exit Sub
errhand:
	Messagebox "Error Code " & Err() & " - " & Error & " in the create pdf process on line " & Erl() & ".", 16, "Printer Error"
	Print "Error Code " & Err() & " - " & Error & " in the create pdf process on line " & Erl() & "."
	Exit Sub
End Sub





'CheckRegistry function:
Function CheckRegistry( defprinter As String, defdriver As String, defport As String, action As String )

	' Declare constants for use in reading and writing the registry
	Const HKEY_CURRENT_USER = &H80000001
	Const HKEY_LOCAL_MACHINE = &H80000002
	Const HKCU = HKEY_CURRENT_USER
	Const HKLM = HKEY_LOCAL_MACHINE
	Const SYNCHRONIZE = &H100000
	Const READ_CONTROL = &H20000
	Const STANDARD_RIGHTS_ALL = &H1F0000
	Const STANDARD_RIGHTS_REQUIRED = &HF0000
	Const STANDARD_RIGHTS_READ = (READ_CONTROL)
	Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
	Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
	Const KEY_QUERY_VALUE = &H1
	Const KEY_SET_VALUE = &H2
	Const KEY_CREATE_SUB_KEY = &H4
	Const KEY_ENUMERATE_SUB_KEYS = &H8
	Const KEY_NOTIFY = &H10
	Const KEY_CREATE_LINK = &H20

	Const KEY_READ=((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
	Const KEY_WRITE=((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
	Const KEY_EXECUTE=((KEY_READ) And (Not SYNCHRONIZE))
	Const KEY_ALL_ACCESS=((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

	Const REG_NONE = 0
	Const REG_SZ = 1
	Const REG_EXPAND_SZ = 2
	Const REG_BINARY = 3
	Const REG_DWORD = 4

	Dim result As Long
	Dim keyname As String
	Dim hkey As Long

	' registry key for the default printer
	keyname = "Software\Microsoft\Windows NT\CurrentVersion\Windows"

	' open the registry key containing the default printer
	result = RegOpenKeyEx( HKEY_CURRENT_USER, keyname, 0, KEY_ALL_ACCESS, hkey)

	' if unable to open the key - warn the user and exit the script - we won't be able to change printers
	If result > 0 Then
		Messagebox "Unable to Open the Registry Key for your current default printer. The process will be aborted.", 16, "Unable to Open Registry Key"
		CheckRegistry = "SEVERE"
		Exit Function
	End If

	Dim tmppath$
	Dim buflen As Long
	Dim valuetype As Long
	Dim valuename As String
	Dim printerval As String

	valuetype = 1
	valuename = "Device"

	' determine if the user is getting or setting the default printer
	If action = "query" Then
		tmppath$ = String(256, " ")
		buflen = Len(tmppath$)

		' get the default printer value
		result = RegQueryValueEx( hkey, valuename, 0&, 0&, tmppath, buflen)

		' if unable to query the key - warn the user - otherwise - set the printerstring value
		If result > 0 Then
			Messagebox Cstr(result)
			Messagebox "Unable to determine your current default printer. It will automatically be set to PDFWriter.", 64, "No Default Printer"
			CheckRegistry = "ERROR"
		Else
			printerval = Left$(tmppath$, buflen-1)
			CheckRegistry = printerval
		End If
	End If

	If action = "set" Then
		Dim printersetting As String
		Dim printerlen As Long
	
		printersetting = defprinter + "," + defdriver + "," + defport
		printerlen = Len(printersetting)
		valuename = "Device"
		' set the new default printer to PDFWriter
		result = RegSetValueEx( hkey, valuename, 0&, REG_SZ, Byval printersetting, Len(printersetting))
	
		' if unable to set the key - warn the user and exit the script - we won't be able to print to PDFWriter
		If result > 0 Then
			Messagebox "Unable to Set the Registry Key for your current default printer. The process will be aborted.", 16, "Unable to Set Registry Key"
			CheckRegistry = "SEVERE"
			' if we've gotten this far - we've opened the registry key - so try to close it
			result = RegCloseKey( hkey )
			Exit Function
		Else
			CheckRegistry = "SUCCESS"
		End If
	End If

	' close the registry key
	result = RegCloseKey( hkey )
	Exit Function
End Function





'In the Form Events:
'Declarations:

Declare Sub Sleepx Lib "kernel32.dll" Alias "Sleep" (Byval milliseconds As Long)
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (Byval hwnd As Long, Byval lpOperation As String, Byval lpFile As String, Byval lpparameters As String, Byval lpDirectory As String, Byval nShowCmd As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendNotifyMessageA" (Byval hwnd As Long, Byval wMsg As Long, Byval wParam As Long, lparam As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (Byval hKey As Long, Byval lpSubKey As String, Byval ulOptions As Long, Byval samDesired As Long, phkResult As Long) As Long
Declare Function RegCloseKey Lib "advapi32.dll" Alias "RegCloseKey" (Byval hKey As Long) As Long 
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (Byval hKey As Long, Byval lpValueName As String, Byval lpReserved As Long, lpType As Long, Byval lpData As String, lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (Byval hKey As Long, Byval lpSubKey As String, Byval Reserved As Long, Byval dwType As Long, Byval lpData As String, Byval cbData As Long) As Long
Declare Function SendMessageTimeout Lib "user32.dll" Alias "SendMessageTimeoutA" (
Byval hwnd As Long, Byval msg As Long, Byval wparam As Long, Byval lparam As Long, Byval fuflags As Long, Byval utimeout As Long, lpdwresult As Long) As Long



'PostOpen:
Sub Postopen(uidoc As Notesuidocument)

	uidoc.EditMode = True

	Call uidoc.fieldsettext("ITPrint", "")
	Call uidoc.fieldsettext("CurPrinter", "")
	Call uidoc.fieldsettext("CurDriver", "")
	Call uidoc.fieldsettext("CurPort", "")

	Call uidoc.Save 

End Sub



'QueryClose:
Sub Queryclose(Source As Notesuidocument, Continue As Variant)
	Dim ws As New NotesUIWorkspace
	Dim uidoc As NotesUIDocument
	Dim session As New NotesSession
	Dim cur_doc As NotesDocument
	Dim cur_db As NotesDatabase
	Dim sysname

	Set doc = source.Document 
	Set cur_db = session.CurrentDatabase
	Set uidoc = ws.CurrentDocument
	Set cur_doc = uidoc.Document
	sysname = session.CommonUserName

	Dim printerstring As String
	Dim curprinter As String
	Dim curdriver As String
	Dim curport As String
	Dim lpdwResult As Long
	Dim rc As Long 

	Const WM_SETTINGCHANGE = &H1A
	Const HWND_BROADCAST = &HFFFF
	Const SMTO_NORMAL = 2

	' if ITPrint = "", then the user is simply closing the document 
	If uidoc.fieldgettext("ITPrint") = "" Then
		continue=True
	Else 
		' Make sure printer was successfully set to PDFWriter - if not - exit the sub
		printerstring = CheckRegistry("", "", "", "query")

		If (Instr(1, printerstring, "PDFWriter", 5) = 0) Then
			Messagebox "You do not have the Acrobat PDFWriter selected as your current printer. Please select it and try the transfer again.", 16, "Acrobat PDFWriter not selected"
			Exit Sub 
		End If

		' creating the version of the notes doc in pdf
		Print "Creating the Adobe version of this document."

		' create a new __pdf.ini file and set the PDFFileName variable
		Dim adobein As String
		Dim adobeout As String
		Dim fileIn As Integer
		Dim fileOut As Integer
		Dim fileChk As Integer
		Dim txt As String
		Dim pdffile As String
		Dim nopdfini As String
		Dim tempdir As String
		Dim regretcode As String
		Dim retremove As String
	
		nopdfini = ""
		' determine where the __pdf.ini file should reside
		adobein = Environ$("Windir") & "\__pdf.ini"
		adobeout = Environ$("Windir") & "\__pdfout.ini"
	
		' set the temporary directory for processing documents
		tempdir = "C:\temp\"

		' set the adobe file name
		pdffile = tempdir & "temp.pdf"

		' kill any existing copies of the adobe ini output file and pdf files - just in case anything
		' was left behind on a previous transfer
		On Error Resume Next
		Kill adobeout
		' on first attempt - display errors
		retremove = RemovePDF(tempdir, "Y")
		On Error Goto errhand
		If retremove = "SEVERE" Then
			' if they followed directions and closed the Adobe window - try one more time to clean up the files
			' don't display errors on the second call - it's the user's fault now!
			Goto cleanup
		End If

		' Acrobat PDFWriter works in one of two ways. First - if a registry key exists for PDFWriter, then set the
		' string value for PDFFileName. Second, if no registry key exists, create a __pdf.ini file with the PDFFileName

		' First case - set the default pdffile name in the registry
		regretcode = SetDefaultFile(pdffile)

		If regretcode = "SEVERE" Then
			' The Acrobat PDFFileName key was found - but was not able to be updated
			Messagebox "Unable to set the pdf file name in the Registry. The process is aborting.", 16, "Unable to Set PDF File Error"
			' The printer has been changed - set it back to the original default printer and remove pdf files 
			Goto cleanup
		End If

		' Second case - create the __pdf.ini file
		If Not regretcode = "SEVERE" Then
			fileIn% = Freefile()
			Open adobein For Input As fileIn%
			fileOut% = Freefile()
			Open adobeout For Output As fileOut%
	
			If nopdfini = "" Then
				Do While Not Eof(fileIn%)
					' Read each line of the original __pdf.ini file and create a new ini file
					Line Input #fileIn%, txt$
					If txt$ = "[Acrobat PDFWriter]" Then
						Print #fileOut%, txt$
						Print #fileOut%, "PDFFileName=" + pdffile
					Else
						If (Instr(1,txt$,"PDFFileName=",5) = 0) Then
							Print #fileOut%, txt$ 
						End If
					End If
				Loop

				Close fileIn%
				Close fileOut%

				Kill adobein
			Else
				' Create a new __pdf.ini file
				Print #fileOut%, "[Acrobat PDFWriter]"
				Print #fileOut%, "PDFFileName=" + pdffile
				Close fileOut%
			End If

			Filecopy adobeout, adobein
			Kill adobeout
		End If

		' check to see if the __pdf.ini file was created successfully by trying to open it
		fileChk% = Freefile()
		Open adobein For Input As fileChk%

		' if the registry key couldn't be opened and the __pdf.ini file were not successfully created - warn and exit
		If (nopdfini = "Y") And (regretcode = "ERROR") Then
			Messagebox "Unable to set the pdf file name. The process is aborting.", 16, "Unable to Set PDF File Error"
			' The printer has been changed - set it back to the original default printer and remove pdf files
			Goto cleanup
		End If
		Close fileChk%

		' call the uidoc print method - since the printer is set to PDFWriter, this will convert the notes doc to a pdf file
		Call uidoc.print(1)

		' pause the script for a couple of seconds so the print can complete
		Call sleepx(2500)

		' pdf file creation is successful - launch an instance of Adobe
		Print "Launching the pdf file: " & pdffile & " in Adobe."

		Dim rv As Integer

		Call DoWithFileAndApp(pdffile,"open")

		' pause the script to give them time to launch adobe and the pdf file
		Call sleepx(10000)

cleanup: 
		' cleanup removes any and all pdf files, resets the default printer, and resets temporary fields on the doc

		Print "Removing pdf copies of the doc."

		' remove any .pdf files in the temp directory if the cleanup is part of a normal process.
		' if we come into the cleanup do to a severe error, the user will have already received the warning message so try to remove the file a second time.
		If Not retremove = "SEVERE" Then
			retremove = RemovePDF(tempdir, "Y")
		End If
		On Error Goto errhand
		If retremove = "SEVERE" Then
			' if they followed directions and closed the Adobe window - try one more time to clean up the files
			' don't display errors on the second call - it's the user's fault now!
			RemovePDF tempdir, "N"
		End If

		' reset the current default printer to the original default printer
		curprinter = uidoc.fieldgettext("CurPrinter")
		curdriver = uidoc.fieldgettext("CurDriver")
		curport = uidoc.fieldgettext("CurPort")
		rc = CheckRegistry (curprinter, curdriver, curport, "set") 

		' notify windows apps that a registry change has occured
		rc = sendmessagetimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, 0&, SMTO_NORMAL, 3000&, lpdwResult)
		Call sleepx(500) 

	End If

	' reset temporary variables

	Call uidoc.fieldsettext("ITPrint", "")
	Call uidoc.fieldsettext("CurPrinter", "")
	Call uidoc.fieldsettext("CurDriver", "")
	Call uidoc.fieldsettext("CurPort", "")

	Exit Sub

errhand:
	' if the original __pdf.ini file is not found, just create a new one...
	If Err() = 101 Then
		nopdfini = "Y"
		Resume Next
	End If

	' if the error is the result of a locked adobe file during the file remove, the user will have already been warned, reset the default printer and temp variables
	If (Err() = 4412 Or Err() = 75) And (retremove = "SEVERE") Then
		Resume Next
	End If

	Messagebox "Error Code " & Err() & " - " & Error & " in the adobe print process on line " & Erl() & ".", 16, "Adobe Print Error"
	Print "Error Code " & Err() & " - " & Error & " in the adobe print process on line " & Erl() & "."

	On Error Resume Next

	' remove any .pdf files in the temp directory
	RemovePDF tempdir, "Y"
	If retremove = "SEVERE" Then
		' if they followed directions and closed the Adobe window - try one more time to clean up the files
		' don't display errors on the second call - it's the user's fault now!
		RemovePDF tempdir, "N"
	End If

	' reset the current default printer to the original default printer
	curprinter = uidoc.fieldgettext("CurPrinter")
	curdriver = uidoc.fieldgettext("CurDriver")
	curport = uidoc.fieldgettext("CurPort")

	rc = CheckRegistry (curprinter, curdriver, curport, "set") 

	' notify windows apps that a registry change has occured
	rc = sendmessagetimeout(HWND_BROADCAST, WM_SETTINGCHANGE, 0&, 0&, SMTO_NORMAL, 3000&, lpdwResult)
	Call sleepx(500) 

	Print "Adobe Print Process Aborted"

	' reset temporary variables
	Call uidoc.fieldsettext("ITPrint", "")
	Call uidoc.fieldsettext("CurPrinter", "")
	Call uidoc.fieldsettext("CurDriver", "")
	Call uidoc.fieldsettext("CurPort", "")

	Exit Sub

End Sub 






'CheckRegistry function:
Function CheckRegistry( defprinter As String, defdriver As String, defport As String, action As String) 

	Const HKEY_CURRENT_USER = &H80000001
	Const HKEY_LOCAL_MACHINE = &H80000002
	Const HKCU = HKEY_CURRENT_USER
	Const HKLM = HKEY_LOCAL_MACHINE

	Const SYNCHRONIZE = &H100000
	Const READ_CONTROL = &H20000
	Const STANDARD_RIGHTS_ALL = &H1F0000
	Const STANDARD_RIGHTS_REQUIRED = &HF0000
	Const STANDARD_RIGHTS_READ = (READ_CONTROL)
	Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
	Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
	Const KEY_QUERY_VALUE = &H1
	Const KEY_SET_VALUE = &H2
	Const KEY_CREATE_SUB_KEY = &H4
	Const KEY_ENUMERATE_SUB_KEYS = &H8
	Const KEY_NOTIFY = &H10
	Const KEY_CREATE_LINK = &H20

	Const KEY_READ=((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
	Const KEY_WRITE=((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
	Const KEY_EXECUTE=((KEY_READ) And (Not SYNCHRONIZE))
	Const KEY_ALL_ACCESS=((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

	Const REG_NONE = 0
	Const REG_SZ = 1
	Const REG_EXPAND_SZ = 2
	Const REG_BINARY = 3
	Const REG_DWORD = 4

	Dim result As Long
	Dim keyname As String
	Dim hkey As Long

	keyname = "Software\Microsoft\Windows NT\CurrentVersion\Windows"

	' open the registry key containing the default printer
	result = RegOpenKeyEx( HKEY_CURRENT_USER, keyname, 0, KEY_ALL_ACCESS, hkey)

	Dim tmppath$
	Dim buflen As Long
	Dim valuetype As Long
	Dim valuename As String
	Dim printerval As String

	valuetype = 1
	valuename = "Device"

	If action = "query" Then
		tmppath$ = String(256, " ")
		buflen = Len(tmppath$)

		' get the default printer value
		result = RegQueryValueEx( hkey, valuename, 0&, 0&, tmppath, buflen)

		printerval = Left$(tmppath$, buflen-1)
		CheckRegistry = printerval

	End If


	If action = "set" Then
		Dim printersetting As String
		Dim printerlen As Long

		printersetting = defprinter + "," + defdriver + "," + defport
		printerlen = Len(printersetting)
		result = RegSetValueEx( hkey, valuename, 0&, REG_SZ, Byval printersetting, Len(printersetting))
	End If

	result = RegCloseKey( hkey )

	Exit Function

End Function




'DoWithFileAndApp function:
Function DoWithFileAndApp(fName As String, action As String) As Long

	Dim hwnd As Long
	Dim fAction As Long
	Select Case action
		Case Lcase("open") : fAction = 2
		Case Lcase("print") : fAction = 7
		Case Lcase("close") : fAction = 0
	End Select

	R& = ShellExecute(hwnd,Action,fName,"","",fAction)
	Exit Function
End Function




'SetDefaultFile function:
Function SetDefaultFile(nameoffile As String)
	' declare the constants for reading and setting the registry values
	Const HKEY_CURRENT_USER = &H80000001
	Const HKEY_LOCAL_MACHINE = &H80000002
	Const HKCU = HKEY_CURRENT_USER
	Const HKLM = HKEY_LOCAL_MACHINE

	Const SYNCHRONIZE = &H100000
	Const READ_CONTROL = &H20000
	Const STANDARD_RIGHTS_ALL = &H1F0000
	Const STANDARD_RIGHTS_REQUIRED = &HF0000
	Const STANDARD_RIGHTS_READ = (READ_CONTROL)
	Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
	Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL)
	Const KEY_QUERY_VALUE = &H1
	Const KEY_SET_VALUE = &H2
	Const KEY_CREATE_SUB_KEY = &H4
	Const KEY_ENUMERATE_SUB_KEYS = &H8
	Const KEY_NOTIFY = &H10
	Const KEY_CREATE_LINK = &H20

	Const KEY_READ=((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
	Const KEY_WRITE=((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
	Const KEY_EXECUTE=((KEY_READ) And (Not SYNCHRONIZE))
	Const KEY_ALL_ACCESS=((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))

	Const REG_NONE = 0
	Const REG_SZ = 1
	Const REG_EXPAND_SZ = 2
	Const REG_BINARY = 3
	Const REG_DWORD = 4

	Dim result As Long
	Dim keyname As String
	Dim hkey As Long

	keyname = "Software\Adobe\Acrobat PDFWriter"

	' open the registry key containing the default pdf file name
	result = RegOpenKeyEx( HKEY_CURRENT_USER, keyname, 0, KEY_ALL_ACCESS, hkey)
	If result > 0 Then
		' the registry key was not found, exit the function and create a __pdf.ini file
		SetDefaultFile = "ERROR"
		Exit Function
	End If

	Dim tmppath$
	Dim buflen As Long
	Dim valuetype As Long
	Dim valuename As String
	Dim printerval As String

	valuetype = 1
	valuename = "PDFFileName"

	Dim pdffilesetting As String
	Dim pdffilelen As Long

	pdffilesetting = nameoffile + "*"
	pdffilelen = Len(printersetting)
	result = RegSetValueEx( hkey, valuename, 0&, REG_SZ, Byval pdffilesetting, Len(pdffilesetting))

	If result > 0 Then
		' the registry key was found, but setting the pdfilename was unsuccessful
		SetDefaultFile = "SEVERE"
		result = RegCloseKey( hkey )
		Exit Function
	End If

	' if we got this far - the key was successfully opened, so close the registry key
	result = RegCloseKey( hkey )

	SetDefaultFile = "SUCCESS"

	Exit Function
End Function




'RemovePDF function:
Function RemovePDF(tempdir, witherr)

	If witherr = "Y" Then
		On Error Goto funcerror
	End If

	Dim pathName As String
	Dim fileid As String
	Dim killarray()
	Dim killint As Integer

	Print "Removing pdf copies of the document in the " + tempdir + " directory."

	RemovePDF = "SUCCESS"

	Redim killarray(1 To 1)
	killint = 0

	pathName$ = tempdir + "*.pdf"
	fileid$ = Dir$(pathName$, 0)

	Do While fileid$ <> ""
		killint = killint + 1
		Redim Preserve killarray(1 To killint)
		killarray(killint) = fileid$
		fileid$ = Dir$()
	Loop

	Forall kf In killarray
		If Not kf = "" Then
			Kill tempdir + kf
		End If
	End Forall

	Exit Function
funcerror: 
	' if pdf file is already open in acrobat - notify and abort - put resume so we can delete as many files as possible
	If Err() = 4412 Or Err() = 75 Then
		Messagebox "It appears you have a document open in Adobe. Please close the Adobe window/application and then click on the OK button.", 16, "Potential File Risk"
		RemovePDF = "SEVERE"
		Resume Next
	End If
End Function

Open in new window

Hi I am looking for same solution but I am using Print to File or Email. I tried to use the above code but prompting the Saveas dialog box. Any help will be Appreciated