par Nicolas » 16 Jan 2004 à 10:34
hé hé, non non rassures-toi c'est pas du flicage de mail (sinon j'aurais aussi ajouté en base le body du mail, tant qu'à faire !), c'est une boite qui est dédiée à une application qui envoie des flux...Si vraiment le sujet te passionne tu peux toujours me filer un coup de main, mais ceci dit le seul problème qui me reste à résoudre pour l'instant c'est cette question de pièce jointe qui n'est plus accessible.Le détachement de ces pièces jointes n'est pas, urgent du tout (c'est même pas sûr qu'on en ait besoin)Pour ceux que ça peut interresser voici le code de mon agent :------------------Option PublicOption DeclareUselsx "*LSXODBC"%INCLUDE "lserr.lss"------------------Sub Initialize On Error Goto TrtErreur Dim session As New NotesSession Dim db As NotesDatabase Dim collec As NotesDocumentCollection Dim doc As NotesDocument Dim con As New ODBCConnection Dim qry As New ODBCQuery Dim res As New ODBCResultSet Dim object As NotesEmbeddedObject Dim adresseFrom, sujet, code, listePJ As String Dim cnt As Variant Dim nbPJ As Integer '-------------- ' Début '-------------- Set db = session.CurrentDatabase Set collec = db.UnprocessedDocuments ' eh oui je l'utilise quand même, question performances ça évite tout de même de re-lire à chaque fois tous les mails de la base... Print "#-- MailCheck --- Début - " + Cstr(collec.count) + " mails à vérifier." Set doc = collec.GetFirstDocument() If (doc Is Nothing) Then Exit Sub End If ' => "Connection" en local sur l'as400 (le nom "S*******" apparait par la commande WRKRDBDIRE sur l'as400). con.autocommit=True If (con.connectto("S*******","PROFIL","password")) Then Print ("MailCheck : Connected to AS400") Set qry.Connection = con Set res.Query = qry Else Print ("Erreur TFDOM : " + Cstr(con.Error) +Cstr(con.GetExtendedErrorMessage)) Exit Sub End If ' Boucle de lecture des mails reçus While Not(doc Is Nothing) If (doc.checked(0)<>"OK") Then ' On remplace les quotes par des doubles quotes pour SQL400... adresseFrom = ReplaceSubstring (doc.INetFrom(0), "'", "''") If (adresseFrom ="") Then adresseFrom =ReplaceSubstring (doc.From(0), "'", "''") End If sujet= ReplaceSubstring (doc.subject(0), "'", "''") code="" If (doc.FailureReason(0)<>"") Then code="ECHEC" End If listePJ="" nbPJ=0 ' toutes les pièces jointes: ' c'est là que ça marche pas donc je l'ai mis en commentaires: ' Forall i In doc.Items ' If ( i.type = ATTACHMENT) Then ' nbPJ=nbPJ+1 ' listePJ=listePJ+"/"+i.Values(0) ' End If ' End Forall ' listePJ= ReplaceSubstring (listePJ, "'", "''") qry.sql ="INSERT INTO BIBLIO.FICHIER VALUES(10000*year(curdate()) + 100*month(curdate()) + day(curdate()), 10000*hour(curtime())+100*minute(curtime()) +second(curtime()), '(CodeApplication)', '"+adresseFrom+"', '"+sujet+"', '"+code+"', "+Cstr(nbPJ)+", '"+listePJ+"')" If (Res.Execute) Then 'doc.subject=doc.subject(0)+" [-OK-]" doc.checked="OK" Call doc.save( True, True) End If End If Set doc = collec.GetNextDocument(doc) cnt=cnt+1 Wend ' FIN : Res.Close(Db_Close) Call con.disconnect Call con.disconnect Print "#-- MailCheck --- Fin : " + Cstr(cnt) + " mails détectés." Exit Sub TrtErreur: Print qry.sql Print ("AS400 : " + Cstr(con.Error) +Cstr(con.GetExtendedErrorMessage)) Print "Erreur : "+ Error + " (ligne " + Cstr(Erl) + " - erreur numero "+Cstr(Err)+")" Exit Sub End Sub------------------Function ReplaceSubstring( StringToScan As String, StringToReplace As String, ReplacementStr As String) As String' Remplace toutes les occurences de StringToReplace dans StringToScan par ReplacementStr Dim ResultStr As String Dim pos As Integer, size As Integer ResultStr = StringToScan ' on travaille sur une copie de la chaine passée en paramètre pos = Instr( StringToScan , StringToReplace ) ' position de la première occurence de StringToReplace size = Len( StringToReplace ) ' longueur en caractères de la chaine de remplacement ' Tant qu'on trouve des occurences de StringToReplace, on les remplace ' APPEL RECURSIF If pos <> 0 Then ResultStr = Mid$( ResultStr, 1, pos-1) & ReplacementStr & ReplaceSubstring(Mid$( ResultStr, pos+size), StringToReplace , ReplacementStr ) End If ReplaceSubstring = ResultStr End Function------------------------Voilà voilà