Issue:
Need ability on PC to send current Notes document (already saved and open) as a PDF attached to an e-mail.
Solution:
Option Public
Option Declare
Use "CoreUtils"
' change printer pdf functions
Dim objWMIService As Variant ' WMI object for getting printers
Dim prnObj As Variant ' WMI printer object
Sub Initialize
' script library contains functions needed to print doc to pdf and send pdf to client
End Sub
Function SetCurPrinterDefault(prnObj As Variant) As Integer
' sets current printer as default
' prnObj - current printer to set as default
Dim prnCol As Variant ' printer collection
On Error Goto FErrorHandler
SetCurPrinterDefault = 0
If (prnObj Is Nothing) Then
' give up
SetCurPrinterDefault = 0
Exit Function
End If
' set default
Call prnObj.SetDefaultPrinter()
SetCurPrinterDefault = 1
FExit:
Exit Function
FErrorHandler:
Print "(SetCurPrinterDefault) Unexpected error: (" & Cstr(Err) & "), " & Error$ & ", " & " on line: " & Cstr(Erl)
SetCurPrinterDefault = 0
Resume FExit
End Function
Function FileTestExists(filenm As String, waitperiod As Integer) As Integer
' tests if file exists, returns 1 for exists, 0 for not there
' filenm - file to check
' waitperiod - how long to wait
Dim sleepcount As Integer ' counter for waitperiod looping
On Error Goto FErrorHandler
' check variables
If (filenm = "") Then
FileTestExists=0
Exit Function
End If
If (waitperiod>0) Then
Sleep waitperiod
End If
' test file
If (Dir$(filenm) = "") Then
' no file exists
FileTestExists=0
Else
' file exists
FileTestExists=1
End If
Exit Function
FErrorHandler:
FileTestExists=0
Exit Function
End Function
Function PrintToPDF(w As NotesUIWorkspace, uiDoc As NotesUIDocument) As Integer
' prints current page to pdf
' returns 1 for success
' call function with "Call PrintToPDF(w, uiDoc)"\
Dim curpc As String
Dim curprinter As String ' default printer before printing pdf
Dim retval As Long
Dim pdfprinter As String ' name of pdf printer
On Error Goto FErrorHandler
' start w/failure
PrintToPDF = 0
curpc = "."
curprinter = ""
pdfprinter = "PDFCreator"
Call GetWMIService(".")
' setup objWMI if not already set
If (objWMIService Is Nothing) Then
' get service
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & curpc & "\root\cimv2")
End If
' print out list of printers on current pc
'Call ListPrinters(objWMIService) ' used to confirm we had PDFCreator as choice
' get current default printer to swap out
curprinter = GetCurrentPrinter(objWMIService)
Print "Current Printer: " & curprinter & "."
' set printer to pdf
Set prnObj = GetPrinterObj(objWMIService, pdfprinter)
If (prnObj Is Nothing) Then
' give up
Print " . . . unable to load PDF printer. Cancelled."
PrintToPDF=0
Exit Function
End If
' set pdfcreator as default
If (SetCurPrinterDefault(prnObj)=1 ) Then
' default set, ... verify changed
Sleep 1 ' does not really switch unless there is a delay
If (Strcompare(pdfprinter, GetCurrentPrinter(objWMIService), 5)=0) Then
' match, print
Print "Printing to " & prnObj.Name & " . . . "
Call uiDoc.Print(1,,,)
PrintToPDF = 1
Exit Function
Else
' setting PDF printer did not work (never seems to be case when it cannot switch)
Print "Could not switch printers. Cannot create PDF."
PrintToPDF = 0
Exit Function
End If
Else
Msgbox "Cannot create PDF compatible printer driver"
PrintToPDF = 0
End If
' set default printer back to whatever it was
Call SetDefaultPrinter(objWMIService, curprinter)
FExit:
Exit Function
FErrorHandler:
Print "(PrintToPDF) Unexpected error. Line:" & Cstr(Erl) & ", Error: " & Cstr(Err) & ", " & Error$
PrintToPDF = 0
Resume FExit
End Function
Function PDFCreate(s As NotesSession, w As NotesUIWorkspace, uiDoc As NotesUIDocument) As Integer
' prints document to pdf via acrobat distiller or pdfcreator
' returns 1 for success
' uiDoc - current document to be printed
On Error Goto FErrorHandler
Print "Printing pdf ..."
' print to pdf file (set's printer, and prints)
If (PrintToPDF(w, uiDoc) = 0) Then
' error quit
Print " ... error creating pdf."
PDFCreate=0
Exit Function
End If
Print "... pdf file created."
' destroy wmi objects
Set objWMIService = Nothing
Set prnObj = Nothing
' return success
PDFCreate = 1
Exit Function
FErrorHandler:
Print "(PDFCreate) Error. Line:" & Cstr(Erl) & ", Error: " & Cstr(Err) & ", " & Error$
PDFCreate = 0
Exit Function
End Function
Function GetPrinterObj(objWMIService As Variant, printnm As String) As Variant
' printnm - printer to retrieve
Dim prnCol As Variant ' collection of printers matching query
On Error Goto FErrorHandler
Set GetPrinterObj = Nothing
GetPrinterObj=0
' get printer(s) with that name
Set prnCol = objWMIService.ExecQuery(|Select * from Win32_Printer Where Name = ' | & printnm & |'|)
' return printer
Forall prnObj In prnCol
' return the only/last printer w/that name
Set GetPrinterObj = prnObj
End Forall
If (GetPrinterObj = 0) Then
' not found by name query, loop and verify
Set prnCol = objWMIService.ExecQuery(|Select * from Win32_Printer|)
Forall prnObj In prnCol
' return the only/last printer w/that name
If ( Strcompare(prnObj.Name, printnm, 5)=0) Then
' match
Set GetPrinterObj = prnObj
Exit Function
End If
End Forall
End If
FExit:
Exit Function
FErrorHandler:
Print "(GetPrinterObj) Unexpected error: (" & Cstr(Err) & "), " & Error$ & ", " & " on line: " & Cstr(Erl)
Set GetPrinterObj = Nothing
End Function
Function CreateMemo(s As NotesSession, w As NotesUIWorkspace, _
memosendto As String, memosubject As String, bodyintro As String, bodysig As String, pdfpath As String) As Integer
' creates memo in user's mail file
' memosendto - sendto e-mail address of client for new memo
' memosubject - subject text of new memo
' pdfpath - path to attachment pdf
Dim mailDb As New NotesDatabase("","") ' user's mail database (where we create survey memo)
Dim mUIDoc As NotesUIDocument ' the new memo doc being composed front-end
Dim mDoc As NotesDocument ' backend of mUIDoc
Dim mBody As NotesRichTextItem ' body field of mDoc
Dim mObject As NotesEmbeddedObject ' attachment pdf
On Error Goto FErrorHandler
On Error 4294 Goto UserNotFoundHandler
' get mail file
Call mailDb.OpenMail()
' test mailDb
If Not (mailDb.IsOpen) Then
' error opening mail db
CreateMemo = 0
Exit Function
End If
' create new memo
Set mDoc = mailDb.CreateDocument()
mDoc.Form = "Memo"
mDoc.Subject = memosubject
mDoc.SendTo = memosendto
Set mBody = New NotesRichTextItem(mDoc, "Body")
Call mBody.AppendText(bodyintro)
Call mBody.AddNewline(2)
Set mObject = mBody.EmbedObject( EMBED_ATTACHMENT, "", pdfpath)
Call mBody.AddNewline(2)
Call mBody.AppendText(bodysig)
Call mDoc.Save(True, False)
' open to ui in edit mode
Call w.EditDocument(True, mDoc)
CreateMemo = 1
Exit Function
FErrorHandler:
Print "(CreateMemo) Error. Line:" & Cstr(Erl) & ", Error: " & Cstr(Err) & ", " & Error$
CreateMemo = 0
Exit Function
UserNotFoundHandler:
CreateMemo = 0
Exit Function
End Function
Function GetCurrentPrinter(objWMIService As Variant) As String
Dim prnCol As Variant ' printer collection
On Error Goto FErrorHandler
Set prnCol = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = True")
Forall prnObj In prnCol
GetCurrentPrinter = prnObj.Name
End Forall
FExit:
Exit Function
FErrorHandler:
Print "(GetCurrentPrinter) Unexpected error: (" & Cstr(Err) & "), " & Error$ & ", " & " on line: " & Cstr(Erl)
GetCurrentPrinter = ""
Resume FExit
End Function
Function ListPrinters(objWMIService As Variant) As Integer
Dim prnCols As Variant ' collection of printers matching query
' get printers
Set prnCols = objWMIService.ExecQuery("Select * from Win32_Printer")
Forall prnObj In prnCols
Print "Printer: " & prnObj.Name
End Forall
End Function
Function PDF2Mail(s As NotesSession, w As NotesUIWorkspace, pdfpath As String, _
bodyintro As String, bodysig As String, doc As NotesDocument) As Integer
' bodyintro ' memo body intro - created using form fields and static text
' bodysig ' memo body sig - created using form fields and static text
Dim memosendto As String ' memo sendto / email address
Dim memosubject As String ' memo subject
Dim db As NotesDatabase ' current database, used for lookup views
Dim cDoc As NotesDocument ' current doc (uiDoc.Document)
On Error Goto FErrorHandler
' setup enviornment
Set db = s.CurrentDatabase
' get client doc
Set cDoc = ...
...
If (cDoc Is Nothing) Then
' cancel
PDF2Mail=0
Print "Unabled to load client doc. Cancelled."
Exit Function
End If
memosendto=cDoc.EmailSendToField(0) ' we have only one value
If (memosendto="") Then
' get contact e-mail, billing not populated
memosendto=cDoc.Email(0)
End If
memosubject=cDoc.TitleForSubject(0)
' watch pdf output folder for file
If (FileTestExists(pdfpath, 3)=0) Then
' file does not exist, cancel
PDF2Mail=0
Print "Unable to access PDF file. Cancelled"
Exit Function
End If
' file exists, create new memo and attach pdf file
If (CreateMemo(s, w, memosendto, memosubject, bodyintro, bodysig, pdfpath)=0) Then
' failure, promt user and let them know where PDF file exists to send it manually
Call w.Prompt(1, "Error Creating Memo", "Sorry, I was unable to create memo with PDF attached. Here is path to the PDF: " & pdfpath & ".")
PDF2Mail=0
Exit Function
End If
' memo sent, kill pdf file
Call FileKill(pdfpath)
PDF2Mail=1
Exit Function
FErrorHandler:
Print "(PDF2Mail) Error. Line:" & Cstr(Erl) & ", Error: " & Cstr(Err) & ", " & Error$
PDF2Mail = 0
Exit Function
End Function
Function GetWMIService(curpc As String) As Variant
' dimmed globally
On Error Goto FErrorHandler
' get wmi service root
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & curpc & "\root\cimv2")
FExit:
Exit Function
FErrorHandler:
Print "(GetWMIService) Unexpected error: (" & Cstr(Err) & "), " & Error$ & ", " & " on line: " & Cstr(Erl)
Set GetWMIService = Nothing
Resume FExit
End Function
Function FileKill(expfilenm As String) As Integer
On Error Goto FErrorHandler
' kill existing file passed
Kill expfilenm
' return success
FileKill = 1
Exit Function
FErrorHandler:
Print "(FileKill) Error" & Cstr(Err) & ": " & Error$ & " at line # " & Cstr(Erl)
FileKill = 0
Exit Function
End Function
Function SetDefaultPrinter(objWMIService As Variant, printnm As String) As Integer
' sets any installed printer as default
' objWMIService - wmi service on computer w/printer
' printnm - printer to set as default
Dim prnCol As Variant ' printer collection
On Error Goto FErrorHandler
SetDefaultPrinter = 0
If (objWMIService Is Nothing) Then
' give up
SetDefaultPrinter = 0
Exit Function
End If
' get printers
Set prnCol = objWMIService.ExecQuery(|Select * from Win32_Printer Where Name = '| & printnm & |'|)
' ("Select * from Win32_Printer Where Name = 'ScriptedPrinter'")
Forall prnObj In prnCol
Call prnObj.SetDefaultPrinter()
SetDefaultPrinter = 1
End Forall
If (SetDefaultPrinter=0) Then
' not found by name query, loop and verify
Set prnCol = objWMIService.ExecQuery(|Select * from Win32_Printer|)
Forall objPrinter In prnCol
' return the only/last printer w/that name
If ( Strcompare(objPrinter.Name, printnm, 5)=0) Then
' match, set as default
Call objPrinter.SetDefaultPrinter()
SetDefaultPrinter = 1
Exit Function
End If
End Forall
End If
FExit:
Exit Function
FErrorHandler:
Print "(SetDefaultPrinter) Unexpected error: (" & Cstr(Err) & "), " & Error$ & ", " & " on line: " & Cstr(Erl)
SetDefaultPrinter = 0
Resume FExit
End Function
________________
Another version:
************
Declarations (In a script Lib)
************
REM "This code has been tested on a windows NT and Windows 2000 terminal, this has not been tested on any other platform"
REM "These are standard windows API calls to access the systems registry. Unfortunatly notes does not provide an easy efficient"
REM "way of setting the printer before printing, therefore using windows API and setting the default printer was the best alternative"
Declare Function WriteProfileString Lib "kernel32" Alias "WriteProfileStringA" (Byval lpszSection As String, Byval lpszKeyName As String, Byval lpszString As String) As Long
'Using the sendnotifymessage lib to let notes realise that the default printer has changed
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (Byval hwnd As Long, Byval wMsg As Long, Byval wParam As Long, lParam As Any) As Long
Const WM_WININICHANGE = &H1A
Const HWND_BROADCAST = &HFFFF
****************
In a script Lib
****************
Sub SetPrinter(PrintDevice As String)
Dim ReturnValue As Long
Dim PrinterName As Variant
REM "Sets printername to 'PrintDevice' this is passed from the PrintView timer event"
REM "The text 'winspool' is added on the end as this is required in the registry to print"
PrinterName = PrintDevice + ",winspool"
REM "Writes the new default printer into the registry"
ReturnValue = WriteProfileString("windows", "Device", PrinterName)
REM "As notes does not recognise changes unless restarted, this announces the change to the system."
Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, Byval "Windows")
End Sub
***************
In View(Globals) or where ever you what to put the code
***************
**********
Options
**********
Option Public
REM "Uses the lib 'changeprinter' to set the default printer"
Use "ChangePrinter"
************
The actual Code
************
REM "Obtains the printer device to print to from the document"
PrintDevice = UIDoc.FieldGetText("PrintDevice")
PrinterName = PrintDevice
REM "Calls the scrip lib, passes the printer info to the lib and sets it to the default printer
Call SetPrinter(PrinterName)
REM "Displays new printer (usefull to check events are working correctly)
Print "Set printer to " & PrinterName
REM " do add parameter to avoid print dialog"
Call UIDoc.Print(1)
End Sub
previous page
|