Print attachments with OLE Automation or a WindowsAPI

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".



Option Explicit

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

' 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"

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
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. 

' 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

Public Sub PrintAllAttachments (doc As NotesDocument)
Prints out attachments in the document
	doc, the Notes document
	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)
Prints out the attachment. 
If the extension is not supported or the application is not installed, messagebox to the user.

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.

	o, the NotesEmbeddedObject to print
	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 = "" 
		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
	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	
Gets (if exists) or creates a temporary directory temp in the Notes data directory

	The temporary directory, terminated by ""
	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
	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
	NewInstance = True
	On Error 208 Goto err208
	Set app = createobject("PowerPoint.application")
	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
	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		
			msg = "File not found"
			msg = "Path not found"
			msg = "Access denied"
			msg = "Out of memory"
			msg = "DLL not found"
			msg = "A sharing violation occurred"
			msg = "Incomplete or invalid file association"
			msg = "DDE Time out"
			msg = "DDE transaction failed"
			msg = "DDE busy"
			msg = "No association for file extension"
			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)
		Print("Printing attachment : " & fname)
	End If
End Sub

This was first published in August 2001

There are Comments. Add yours.

TIP: Want to include a code block in your comment? Use <pre> or <code> tags around the desired text. Ex: <code>insert code</code>

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy
Sort by: OldestNewest

Forgot Password?

No problem! Submit your e-mail address below. We'll send you an email containing your password.

Your password has been sent to:

Disclaimer: Our Tips Exchange is a forum for you to share technical advice and expertise with your peers and to learn from other enterprise IT professionals. TechTarget provides the infrastructure to facilitate this sharing of information. However, we cannot guarantee the accuracy or validity of the material submitted. You agree that your use of the Ask The Expert services and your reliance on any questions, answers, information or other materials received through this Web site is at your own risk.