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