Print directly all attachement

Some user need to print all mail attachement with one action. This tips use Windows API (Win32) call Shellexcecute with Print parameter. Easy to implement everywhere in form in action menu or view.
Have Fun

(Declarations)

Const ERROR_FILE_NOT_FOUND = 2           ' File not found
Const ERROR_PATH_NOT_FOUND = 3           ' Path not found
Const ERROR_BAD_FORMAT = 11              ' EXE file invalid
Const SE_ERR_ACCESSDENIED = 5            ' Access denied
Const SE_ERR_ASSOCINCOMPLETE = 27        ' Filename association invalid or 
                                           incomplete
Const SE_ERR_DDEBUSY = 30                ' DDE already busy
Const SE_ERR_DDEFAIL = 29                ' DDE failed
Const SE_ERR_DDETIMEOUT = 28             ' DDE timeout
Const SE_ERR_NOASSOC = 31                ' No application associated with this
                                             extension
Const SE_ERR_OOM = 8                     ' Not enough memory to complete the
                                             operation

 Dim tmprep As String
Dim ret As Integer
Dim NewDoc As NotesDocument
Dim Noms As Variant
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

Function RendTmpRepertoire
On Error Goto err_env
 RendTmpRepertoire= Environ("TEMP")
Exit Function
err_env:
Msgbox "Votre variable d'environnement TEMP n'existe pas. Contactez votre administrateur."
RendTmpRepertoire = ""
Exit Function
End Function

Sub Initialize
    	Dim workspace As New NotesUIWorkspace
    	Dim uidoc As NotesUIDocument
    	Set uidoc = workspace.CurrentDocument
    	Dim Session As New NotesSession
    	Dim db As NotesDatabase
    	Set db = Session.CurrentDatabase
    	Dim doc As NotesDocument
    	Set doc = session.DocumentContext
    	Dim LogFileNumber As Integer
    	Dim LogFileName As String
    	Dim hwnd As Long 'the windows handle don't need to initalize
    	Dim lpOperation As String
    	Dim lpFile As String
    	Dim lpParameters As String
    	Dim lpDirectory As String
    	Dim nShowCmd As Long
    	Dim Hwin32 As Long 'the windows target handle dont need to initalize
    	Dim Ret As Integer
         	Randomize
    	TmpRep= RendTmpRepertoire
    	If TmpRep = "" Then
       Msgbox  "Erreur R?rtoire Temporaire introuvable. Veuillez contr?ler la configuration de votre syst?" , 16 , "Erreur R?rtoire Temporaire"
        	Exit Sub
    	End If
    	Ret = ModeleDetachePourVueUI( db )
       	If Ret = False Then
                Msgbox "Une erreur a eu lieu lors du d?chement des pi?s jointes"
   	Exit Sub
    	End If
    	Dim j As Integer
     ' open report file
    	LogFileNumber = Freefile()
    	LogFileName = "prn_rep.txt"
    	Open TmpRep & "" & LogFileName For Output As LogFileNumber
            Print #LogFileNumber, "Les documents attach?suivants ont ? trait?:"
    	Print #LogFileNumber, " "
    	If Not Isempty(Noms) Then
        		For j = 0 To Ubound(Noms)
               ' Initialize the vars
          	lpFile = Noms(j) 'Describe the file name
           	lpDirectory = TmpRep 'Describe file location
           	nShowCmd =0 'Show the open file
           	lpOperation = "Print" 'if you want to open the file change to "Open"
              ' and finally execute the action on the file
           	Hwin32 = ShellExecute(hwnd, lpOperation, lpFile, "", lpDirectory, nShowCmd)
             ' traitement des codes de retour du ShellExecute
Select Case Hwin32
Case 0
Print #LogFileNumber, Noms(j) & " : La m?ire ou les ressources de la machine sont insuffisantes."
Case ERROR_FILE_NOT_FOUND
Print #LogFileNumber, Noms(j) & " : Le fichier n'a pas ? trouv?
Case ERROR_PATH_NOT_FOUND
Print #LogFileNumber, Noms(j) & " : Le chemin d'acc?au fichier n'a pas ? trouv?
Case ERROR_BAD_FORMAT
Print #LogFileNumber, Noms(j) & " : Le fichier .EXE est invalide."
Case SE_ERR_ACCESSDENIED                   ' Access denied
Print #LogFileNumber, Noms(j) & " : Acc?impossible"
Case SE_ERR_ASSOCINCOMPLETE          ' Filename association invalid or incomplete
Print #LogFileNumber, Noms(j) & " : Association ?e type de fichier incompl? ou invalide."
Case SE_ERR_DDEBUSY                           ' DDE already busy
Print #LogFileNumber, Noms(j) & " : DDE d? utilis?
Case SE_ERR_DDEFAIL                             ' DDE failed
Print #LogFileNumber, Noms(j) & " : Echec de la requ? DDE."
Case SE_ERR_DDETIMEOUT                     ' DDE timeout
Print #LogFileNumber, Noms(j) & " : Timeout DDE."
Case SE_ERR_NOASSOC                            ' No application associated with this extension
Print #LogFileNumber, Noms(j) & " : Pas d'application associ??ette extension."
Case SE_ERR_OOM                    
Print #LogFileNumber, Noms(j) & " : Pas assez de m?ire pour finir la requ?."
Case Is > 32
Print #LogFileNumber, Noms(j) & " : impression correcte."
Case Else
Print #LogFileNumber, Noms(j) & " : Erreur inconnue."
End Select
Next
Close LogFileNumber
Hwin32 = ShellExecute(hwnd, lpOperation, LogFileName, "", lpDirectory, nShowCmd)
End If
End Sub

Function ModeleDetachePourVueUI (db As NotesDatabase) As Integer
    	ModeleDetachePourVueUI = True
    	Dim workspace As New NotesUIWorkspace
    	Dim view As NotesView
    	Dim doc As NotesDocument
    	Dim embobj As NotesDocument
    	Dim collection As NotesDocumentCollection
    	Dim rtitem As Variant
    	Dim NomsDocCourant As Variant
    	Dim NbNoms As Integer 
    	Set collection = db.UnprocessedDocuments
    	For jj = 1 To collection.Count
       		Set doc = collection.GetNthDocument( jj )     
        		If doc Is Nothing Then
               		ModeleDetachePourVueUI = True
            		Exit Function
        		End If
        		Const ConstNoms = "@AttachmentNames"
                 		NomsDocCourant = Evaluate(ConstNoms ,doc)
        		NbNoms = Ubound(NomsDocCourant)
          If Trim( NomsDocCourant(0)) <> "" Then 
         	'Traitement des attachements
	For i = 0 To NbNoms
           	Set rtitem = doc.GetAttachment( NomsDocCourant(i) )                    
           	If rtitem.Type = EMBED_ATTACHMENT Then
           	Print "D?chement du fichier "+NomsDocCourant(i)
           	Print tmprep & "" & NomsDocCourant(i)
 	' Calcule la partie gauche du nom de fichier temporaire => 4 caracteres
   	NouveauNomFichier = Trim(Left$(NomsDocCourant(i), 4))
       	If Instr(NouveauNomFichier, ".") > 0 Then
       	NouveauNomFichier = Trim(Left(NouveauNomFichier, Instr(NouveauNomFichier, ".") - 1))
   	End If
                   ' Ajoute 4 caracteres aleatoires
                 Aleatoire = Trim(Str( Round(Rnd() * 10000,0)))
                 NouveauNomFichier = NouveauNomFichier & Aleatoire 
                  ' Calcule l'extension du fichier
                 ExtensionFichier = Trim(NomsDocCourant(i))
                 While (Instr(ExtensionFichier, ".") > 0)
                ExtensionFichier = Trim(Right$(ExtensionFichier, Len(ExtensionFichier) - Instr(ExtensionFichier, ".")))
                 Wend
                    ' Coupe l'extension a 3 caracteres
                 	If Len(ExtensionFichier) > 3 Then
                ExtensionFichier = Left$(ExtensionFichier, 3)
                	End If
                 ' Ajoute l'extension du fichier
                 	NouveauNomFichier = NouveauNomFichier & "." & ExtensionFichier
                    ' TODO remplacer les espaces par des "_"
	While (Instr(NouveauNomFichier , " ") > 0)
	NouveauNomFichier  = Trim(Left$(NouveauNomFichier , Instr(NouveauNomFichier, " "))) & Trim(Right$(NouveauNomFichier , Len(NouveauNomFichier) - Instr(NouveauNomFichier, " "))) 
                Wend
                ' extrait le fichier temporaire
 	Call rtitem.ExtractFile(tmprep & "" & NouveauNomFichier)
                    ' Met a jour le nom temporaire du fichier dans la liste
 	NomsDocCourant(i) = NouveauNomFichier
	End If                    
	Next   
          ' Sauvegarde des fichiers detaches
          ' ajouter chaque element a la liste
          If Isempty(Noms) Then
         Noms = NomsDocCourant
         Else
	' boucle pour ajouter chaque element
                	Forall Element In NomsDocCourant
                 Redim Preserve Noms (Ubound(Noms) + 1)
                 Noms(Ubound(Noms)) = Element
                	End Forall              
         End If
         	End If
    	Next     
    	Exit Function
ARRET:
     If (Err <> 0) Then Msgbox "Une erreur a eu lieu lors du d?chement de " & Noms(i)
     ModeleDetachePourVueUI = True
    	Exit Function
End Function
This was first published in March 2001

Dig deeper on Domino Resources - Part 6

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

SearchWinIT

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

SearchVirtualDataCentre.co.UK

Close