Enregistrer une pice jointe de mail

[Michael DELIQUE]

as tu lu ça => http://forum.dominoarea.org/initiation- ... 12997.html

[clementbp]

Bonjour

Bon j'ai un petit peu avancé sur le sujet.
J'ai donc créé un agent qui depuis une vue, quand je selectionne un mail, récupère les pièces jointes du mail et les enregistre dans un repertoire.

Le début semble fonctionner correctement par contre le fichier qui est enregistré est vide et je ne comprend pas pourquoi.

Avez vous une idée ?

Merci

Voici mon code :

Sub Initialize()


Dim Session As New NotesSession
Dim doc As NotesDocument
Set doc = session.DocumentContext

Dim rtitem As Variant
Set rtitem = doc.GetFirstItem( "Body" )

Dim Compteur As Integer
Compteur = 0

If ( rtitem.Type = RICHTEXT ) Then
ForAll o In rtitem.EmbeddedObjects
Compteur = Compteur + 1
Call o.ExtractFile ( "c:\Emplacement du Fichier\Document " & CStr(Compteur))
End ForAll
End If



End Sub

[clementbp]

J'ai trouvé, il manque le .pdf à la fin du nom du fichier.

[sebo13]

Bonjour,

Désolé de déterrer de vieux post.
J'utilise le code ci-dessous que je trouve très bien (on ne va pas réinventer la roue).
J'ai un problème d'erreur (wchamp is empty ou wFileName) , je me doute
que le problème vient de la partie iniatilize et que je renseigne mal l'appel de la fonction "FileDetachAll".

Pourriez vous m'aider sur cette partie ?

Merci d'avance de votre aide.

codé vite fait, s'il manque des fonction tu les trouvera dans les tips

Code : Tout sélectionner

Dim Session As NotesSession
   Dim UIWork As NotesUIWorkspace
   Dim db As NotesDatabase
   Dim Collection As NotesDocumentCollection
   Dim Doc As NotesDocument
   Dim vrValue As Variant
   
   On Error GoTo CatchError
   
   Set Session = New NotesSession
   Set db = session.Currentdatabase
   Set Collection = db.Unprocesseddocuments
   If Collection Is Nothing Then
      Exit Sub
   ElseIf collection.Count = 0 Then
      Exit sub
   End If
   
   Set UIWork = New NotesUIWorkspace
   
   vrValue = UIwork.SaveFileDialog(True," Select directory",,"C:")
   
   Set Doc = Collection.Getfirstdocument()
   While Not doc Is Nothing
      Call FileDetachAll(Doc, "",vrValue(0),"")
      Set Doc=  Collection.Getnextdocument(Doc)
   Wend
Set Collection = nothing

Exit Sub
CatchError:
MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Sub

Code : Tout sélectionner

Function FileDetachAll(wDoc As notesdocument, Byval wChamp As String,wDirectory As String, Byval wnbPath As Boolean, Byval wnbDelete As Boolean, wnbSave As Boolean)As Variant

   Dim rtitem As NotesRichTextItem
   Dim lstValue List As String
   Dim i As Integer
   Dim vrEO As Variant
   
   On Error Goto CatchError
   
   lstValue(0) = ""
   
   If wDoc Is Nothing Then
      Error 9999,"wDoc is Nothing"
   Else
      If wDoc.HasEmbedded = False Then
         FileDetachAll = lstValue
         Erase lstValue
         Exit Function
      End If
   End If
   
   If Trim(wChamp) = "" Then
      Error 9999,"wChamp empty"
      Exit Function
   Else
      Set rtitem = wDoc.GetFirstItem(wChamp)
      If rtitem Is Nothing Then
         Error 9999,"rtitem => ''"+wChamp+"'' is nothing"
         Exit Function
      Else
         If (rtitem.Type <> RICHTEXT) Then
            Error 9999,"'"+wChamp+"'' is not NotesRichTextItem"
            Exit Function
         End If
      End If
   End If
   
   If Trim(wDirectory) = "" Then
      Error 9999,"wDirectory empty"
      Exit Function
   Else
      If Right(Trim(wDirectory),1)<>"" Then
         wDirectory = Trim(wDirectory)+""
      Else
         wDirectory = Trim(wDirectory)
      End If
   End If
   
   i=0
   
   If Trim(wChamp) =  "" Then
      vrEO = wDoc.EmbeddedObjects
   Else
      vrEO = rtitem.EmbeddedObjects
   End If
   
   If testVariant(vrEO) = True Then
      Forall Attachement In vrEO
         If Attachement.Type = EMBED_ATTACHMENT Then
            Call Attachement.ExtractFile(wDirectory+Trim(Attachement.Name))
            If wnbPath = True Then
               lstValue(i) = wDirectory+Attachement.Name
            Else
               lstValue(i) = Attachement.Name
            End If
            i=i+1
            If wnbDelete = True Then
               Call Attachement.Remove
            End If
         End If
      End Forall
      vrEO = Null
   End If
   
   Set rtitem = Nothing
   
   If wnbSave = True Then
      Call wDoc.Save(True,False)
   End If
   
   FileDetachAll = lstValue
   Erase lstValue
   
   Exit Function
CatchError:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   Set rtitem = Nothing
   lstValue(0) = "ERROR"
   FileDetachAll = lstValue
   Erase lstValue
   Exit Function
End Function

[Michael DELIQUE]

salut

remplace dans la fonction filedetachall

Code : Tout sélectionner

If Trim(wChamp) = "" Then
      Error 9999,"wChamp empty"
      Exit Function
   Else
      Set rtitem = wDoc.GetFirstItem(wChamp)
      If rtitem Is Nothing Then
         Error 9999,"rtitem => ''"+wChamp+"'' is nothing"
         Exit Function
      Else
         If (rtitem.Type <> RICHTEXT) Then
            Error 9999,"'"+wChamp+"'' is not NotesRichTextItem"
            Exit Function
         End If
      End If
   End If

par

If Trim(wChamp) <> "" Then
Set rtitem = wDoc.GetFirstItem(wChamp)
If rtitem Is Nothing Then
Error 9999,"rtitem => ''"+wChamp+"'' is nothing"
Exit Function
Else
If (rtitem.Type <> RICHTEXT) Then
Error 9999,"'"+wChamp+"'' is not NotesRichTextItem"
Exit Function
End If
End If
End If

[sebo13]

Bonsoir,

Effectivement, je n'ai plus d'erreur. Par contre l'agent n'extrait aucune pièce jointe.
Je l'ai passé en débogage , visiblement il remonte bien le chemin sélectionné , le nom des pièces jointes mais rien n'est exporté dans le dossier cible.

Si vous avez une idée ?

Merci d'avance

[sebo13]

Bonjour,

Après analyse de deboguage , visiblement la fonction "TestVariant" remonte "False" donc logique que l'extraction ne se fasse pas dans la fonction "FileDetachAll".

A suivre

[Michael DELIQUE]

re,

la fonction testvariant a pour but contrôler qu'un variant contient bien qqc dont un array.

[sebo13]

Lors de l'exécussion de :

Code : Tout sélectionner

If Trim(wChamp) =  "" Then
      vrEO = wDoc.EmbeddedObjects
   Else
      vrEO = rtitem.EmbeddedObjects
   End If

vrEO est vide
wdoc ==> EMBEDDEDOBJECTS est vide
On retrouve la pièce jointe dans wdoc ==> ITEMS ==> $FILE

[Michael DELIQUE]

re,

passe le nom du champ richttext ou sont stocker les pj à la fonction

[sebo13]

Bonjour,

Résolu.... je n'étais pas réveillé visiblement.
Merci pour ton aide précieuse.
J'ai honte mais la solution est : Body ......

Cdt