Print attachments with OLE Automation or a WindowsAPI

Print attachments with OLE Automation or WindowsAPI

This Content Component encountered an error
This Content Component encountered an error

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

Dig deeper on Domino Resources - Part 7

0 comments

Oldest 

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:

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchEnterpriseLinux

SearchDataCenter

SearchExchange

SearchContentManagement

Close