This script library provides the ability to print all attachments in a document, from a button in a view or the form.
If you need to support non-Windows clients, you will want to use OLE rather than the "PrintDefault" method, which uses a Windows API. Just modify the "PrintAttachment" method accordingly. Of course, in this case, you won't be able to support non-OLE applications, like Adobe pdf for instance.
The main (and only public) method is PrintAllAttachments. As this is intended for use in mail files, it prints whatever attachments are in the "Body" field. Of course, it can be adapted to scan other field names, or even "all the rich text fields".
Enjoy!
'PrintingUtilities:
Option Explicit
%REM
Lotus Professional Services, July 2001
This library provides printing of attachments from Notes
Tested for Notes/Domino 5.0.3 Intl with MS Office 97 and 2000
%END REM
' Customized error messages
Const MSG_AutomationError = "Unable to find application "
Const MSG_UnableToPrint = "Unable to print file "
Const MSG_Continue = "Click OK to Continue printing supported file types"
Const MSG_NoExtension = "No file extension"
Const MSG_UnknownExtension = "Extension not recognized"
'ShellExecute
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (Byval hwnd As Long, Byval lpszOp As String, Byval lpszFile As String, Byval lpszParams As String, _
Byval LpszDir As String, Byval FsShowCmd As Long) As Long
%REM
Parameter Description
----------------------------------------------------------------------------
hwnd Identifies the parent window. This window receives any message boxes an application produces (for example, for error reporting).
lpszOp Points to a null-terminated string specifying the operation to perform. This string can be "open" or "print." If this parameter is NULL, "open" is the default value.
lpszFile Points to a null-terminated string specifying the file to open.
lpszParams Points to a null-terminated string specifying parameters passed to the application when the lpszFile parameter specifies an executable file. If lpszFile points to a string specifying a document file, this parameter is NULL.
LpszDir Points to a null-terminated string specifying the default directory.
FsShowCmd Specifies whether the application window is to be shown when the application is opened.
%END REM
' Error codes for ShellExecute
Const ERROR_FILE_NOT_FOUND = 2 ' File not found
Const ERROR_PATH_NOT_FOUND = 3 ' Path not found
Const SE_ERR_ACCESSDENIED = 5 ' Access denied
Const SE_ERR_OOM = 8 ' Not enough memory to complete the operation
Const ERROR_BAD_FORMAT = 11 ' EXE file invalid
Const SE_ERR_SHARE = 26
Const SE_ERR_ASSOCINCOMPLETE = 27 ' Filename association invalid or incomplete
Const SE_ERR_DDETIMEOUT = 28 ' DDE timeout
Const SE_ERR_DDEFAIL = 29 ' DDE failed
Const SE_ERR_DDEBUSY = 30 ' DDE already busy
Const SE_ERR_NOASSOC = 31 ' No application associated with this extension
Const SE_ERR_DLLNOTFOUND = 32
Public Sub PrintAllAttachments (doc As NotesDocument)
%REM
Prints out attachments in the document
IN
doc, the Notes document
OUT
nothing
%END REM
Dim rtitem As notesrichtextitem
If doc Is Nothing Then Exit Sub
If doc.HasItem ("Body") = False Then Exit Sub
Set rtitem = doc.GetFirstItem( "Body" )
If ( rtitem.Type = RICHTEXT ) = False Then Exit Sub
If Isempty(rtitem.EmbeddedObjects) Then Exit Sub
Forall o In rtitem.EmbeddedObjects ' loops through all attachments
If ( o.Type = EMBED_ATTACHMENT ) Then
Call PrintAttachment (o)
End If
End Forall
End Sub
Private Sub PrintAttachment ( o As Variant)
%REM
Prints out the attachment.
If the extension is not supported or the application is not installed, messagebox to the user.
Notes:
1) We used OLE for Excel because ShellExecute only prints the first Worksheet.
With the OLE method, we print all worksheets.
2) We did not use OLE for Word and PowerPoint because these apps support several file extensions,
which we would have to hard-code. If needed, these methods can be used, they were tested.
IN
o, the NotesEmbeddedObject to print
OUT
nothing
%END REM
Dim fname As String
Dim Period As String
Dim FileExtension As String
Dim ret As Integer
On Error Goto errHandle
fname = GetTmpDir + o.Source
Call o.ExtractFile ( fname )
Period = Instr(1, fname, ".")
If Period = 0 Then
FileExtension = ""
Else
FileExtension = Mid$(fname, Period, 4)
End If
Select Case Lcase$(FileExtension)
Case ""
Msgbox MSG_NoExtension, 16, MSG_UnableToPrint + fname
' Case ".doc"
' Call PrintMSWord (fname)
Case ".xls"
Call PrintMSExcel (fname)
' Case ".ppt"
' Call PrintMSPowerPoint (fname)
Case Else
PrintDefault (fname)
End Select
Exit Sub
errHandle:
Msgbox "Error " + Cstr(Err) + ": " + Error$ + Chr$(13) + MSG_Continue, 16, MSG_UnableToPrint + fname
Print("Could not print attachment: " & o.source)
Exit Sub
End Sub
Private Function GetTmpDir As String
%REM
Gets (if exists) or creates a temporary directory temp in the Notes data directory
IN
Nothing.
OUT
Nothing.
RETURN
The temporary directory, terminated by ""
%END REM
On Error Goto TmpDirError
Dim s As New NotesSession
Dim TmpDir As String
'Directory is the Notes data Directory
TmpDir = s.GetEnvironmentString ("Directory", True)
TmpDir = TmpDir & "temp"
If Dir$ (TmpDir , 16)="" Then
Mkdir TmpDir
End If
TmpDir = TmpDir & ""
GetTmpDir = TmpDir
Exit Function
TmpDirError:
On Error Goto 0
GetTmpDir = "c:temp"
Exit Function
End Function
Private Sub PrintMSWord (fname As String)
Dim app As Variant
Dim docToPrint As Variant
Dim PrintBackground As Integer
On Error 208 Goto err208
Set app = createobject("Word.application")
Set docToPrint = app.documents.open(fname)
' Turn off background printing to avoid error message cf. Microsoft Technote #Q170393
PrintBackground = app.Options.PrintBackground()
If PrintBackground = True Then app.Options.PrintBackground = False
Call docToPrint.PrintOut()
app.Options.PrintBackground = PrintBackground 'Restore PrintBackground option
Call app.Quit(0)
Set app = Nothing
Exit Sub
err208: 'Cannot create automation object
Msgbox MSG_AutomationError + "MS Word", 16, "Error " + Cstr(Err) + ": " + Error$
Exit Sub
End Sub
Private Sub PrintMSExcel (fname As String)
Dim app As Variant
Dim docToPrint As Variant
On Error 208 Goto err208
Set app = createobject("Excel.application")
Set docToPrint = app.workbooks.open(fname)
' No background printing option available for Excel, no need for special handling
Call docToPrint.PrintOut()
Call app.workbooks.close
Call app.Quit()
Set app = Nothing
Exit Sub
err208: 'Cannot create automation object
Msgbox MSG_AutomationError + "MS Excel", 16, "Error " + Cstr(Err) + ": " + Error$
Exit Sub
End Sub
Private Sub PrintMSPowerPoint (fname As String)
Dim app As Variant
Dim docToPrint As Variant
Dim PrintBackground As Integer
Dim NewInstance As Integer
' Because PowerPoint, unlike Word and Excel, only allows one instance cf. MS Technote #Q222783
On Error 208 Goto createObject
Set app = GetObject (, "PowerPoint.Application")
NewInstance = False
Goto objectCreated
createObject:
NewInstance = True
On Error 208 Goto err208
Set app = createobject("PowerPoint.application")
objectCreated:
app.visible = True ' app has to be visible, error message otherwise
Call app.presentations.open(fname)
' Turn off background printing to avoid error message
Set docToPrint = app.ActivePresentation
PrintBackground = docToPrint.PrintOptions.PrintInBackground
If PrintBackground = True Then app.ActivePresentation.PrintOptions.PrintInBackground = False
Call docToPrint.PrintOut()
docToPrint.PrintOptions.PrintInBackground = PrintBackground 'Restore PrintBackground option
docToPrint.Close
If NewInstance = True Then Call app.Quit() ' Close application only if WE launched it
Set app = Nothing
Exit Sub
err208: 'Cannot create automation object
Msgbox MSG_AutomationError + "MS PowerPoint", 16, "Error " + Cstr(Err) + ": " + Error$
Exit Sub
End Sub
Private Sub PrintDefault (fname As String)
'Ref: Microsoft article Q170918
Dim hwnd As Long
Dim ret As Long
Dim msg As String
ret = ShellExecute(hwnd, "Print", fname, "", "", 0)
If ret<32 Then ' Error
Select Case ret
Case ERROR_FILE_NOT_FOUND
msg = "File not found"
Case ERROR_PATH_NOT_FOUND
msg = "Path not found"
Case SE_ERR_ACCESSDENIED
msg = "Access denied"
Case SE_ERR_OOM
msg = "Out of memory"
Case SE_ERR_DLLNOTFOUND
msg = "DLL not found"
Case SE_ERR_SHARE
msg = "A sharing violation occurred"
Case SE_ERR_ASSOCINCOMPLETE
msg = "Incomplete or invalid file association"
Case SE_ERR_DDETIMEOUT
msg = "DDE Time out"
Case SE_ERR_DDEFAIL
msg = "DDE transaction failed"
Case SE_ERR_DDEBUSY
msg = "DDE busy"
Case SE_ERR_NOASSOC
msg = "No association for file extension"
Case ERROR_BAD_FORMAT
msg = "Invalid EXE file or error in EXE image"
Case Else
msg = "Unknown error"
End Select
Msgbox MSG_UnableToPrint + fname + Chr$(13) + MSG_Continue, 16, msg
Print("Could not print attachment: " & fname)
Else
Print("Printing attachment : " & fname)
End If
End Sub
This was first published in August 2001