Discussion :

[Coin]

Voici un code qui permet d'extraire les mails de lotus sous format .xls.
Pour le fonctionnement de ce code, lotus doit-être sur le poste d'où s'exécute le code.
Ce code permet aussi de classer les mails (à vous de le modifier selon le besoin).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 
Option Explicit
 
Public view As Object      'NOTESVIEW
Public doc As NotesDocument
  Public session As New NotesSession
  Public dir As NotesDbDirectory
  Public db As NotesDatabase
  Const RepDest = "C:\ExtractionMail\"
 
 
 
Private Sub Form_Load()
 
 
'Déclaration Variable
Dim i
Dim j As Integer
Dim k As Integer
Dim n As Integer
Dim Classer As Boolean
 
'Initialisation de la session avec mot de passe
session.Initialize ("MonMDP")
 
'Connexion au serveur
Set dir = session.GetDbDirectory("Serveur")
 
'Connexion au fichier
Set db = dir.OpenDatabase("monfichier.nsf")
 
'Connexion sur la vue de boîte de réception
Set view = db.GetView("($INBOX)")
 
'Se placer sur le premier document
Set doc = view.GetFirstDocument
 
Classer = False
 
'Tant qu'il y a un document
Do While Not doc Is Nothing
    'On regarde l'expéditeur
 
    If InStr(doc.GetFirstItem("From").Text, "toto@titi.fr") Then
        'Boite de dialogue pour voir les infos
        Msgbox "Expéditeur : " & doc.GetFirstItem("From").Text
        msgbox "Date : " & doc.GetFirstItem("PostedDate").Text
        msgbox "Sujet : " & Replace(doc.GetFirstItem("Subject").Text, vbCr, "")
        msgbox "Corps du message : " & Replace(doc.GetFirstItem("Body")
.Text, vbCr, "")
 
        'On classe le mail
        moveToFolder db, doc, "Perso"
 
       Classer = True
 
    End If
 
    If Classer = True Then
        'Si on vient de classer un mail, on reprend la lecture depuis le début
        'Comme on a classer le mail sélectionné, l'objet doc est dans les choux
        Set doc = view.GetFirstDocument
        'Si c'est vide on quitte la boucle
        If doc Is Nothing Then Exit Do
        Classer = False
    Else
        'Sinon on passe au mail suivant
        Set doc = view.GetNextDocument(doc)
    End If
Loop
 
 
End
End Sub
 
Function moveToFolder(dbMailbox As NotesDatabase, docMailbox As NotesDocument, folderName As String) As Boolean
  Dim docMailBoxCopy As NotesDocument
    On Error GoTo handleError
      Set docMailBoxCopy = docMailbox.CopyToDatabase(dbMailbox)
      docMailBoxCopy.PutInFolder folderName, True
      docMailbox.Remove True
    On Error GoTo 0
    moveToFolder = True
    Exit Function
handleError:
  MsgBox "Error # " & Err & " : " & Error$ & " - line " & Erl, 16, "DEMOA Notes Error - moveToFolder"
End Function

Dans cette exemple les mails venant de l'expéditeur toto@titi.fr seulement sont extrait et classer dans le répertoire Perso (Mon dossier Perso est sous la racine Dossier dans la fenêtre Lotus Notes).

Ce code est également adaptable (prévoir quelques changements mineurs) pour du Lotus Script (code permettant de créer des agents).

Si il y a besoin de précision pour la FAQ ou modifier ce posts, afin que d'autres personnes utilisées se code, ne pas hésiter à me prévenir.

@+.

Coin.

[SfJ5Rpw8]

Merci, pour ta contribution

Je teste dés que je rentre au bureau et je te dis quoi ..

j'ai jeté un œil rapide à ton code .., et ton utilisation de la variable "temporaire" item me semble un peu déroutante...

essai pour simplifier ton code de supprimer son utilisation en remplaçant par exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
..
 Set item = doc.GetFirstItem("From")
    If InStr(item.Text, "toto@titi.fr") Then
        'On enregistrer dans le fichier Excel l'expéditeur, la date, le sujet et le corps du message
..

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
..
    If InStr(doc.GetFirstItem("From").Text, "toto@titi.fr") Then
        'On enregistrer dans le fichier Excel l'expéditeur, la date, le sujet et le corps du message
..

pour une entrée dans la faq, il faudrai simplifier ce code, et le recentrer sur le but de celui-ci : "Comment extraire les mails d'une messagerie lotus note" , peu être en oubliant excel et en utilisant un simple messagebox (ou un debug.print) pour l'affichage des données extraites....

[Coin]

Ok,

Je regarde le modif et je réédit le code, pour le modifier...

Coin.

[Coin]

Salut,

Je viens d'enlever la variable objet temporaire qui servait à rien....

J'ai également enlever le lien Excel.

C'est déjà plus simple.

@ +.

Coin.

[plaury]

bonjour,

comment tu fais pour savoir si tu as une pieces jointe et dans ce cas comment l'extraire ?

[Coin]

Salut,

Je ne sais pas récupérer les pièces jointes... Ce n'étais pas le but de mon programme.

Tu de vrais plutôt posé la question sur le Forum !!

Et sinon tu peux récupérer des infos sur ce site :
http://forum.dominoarea.org/index.php

Dans la rubrique Lotus Script, c'est une programation qui est quasiment identique à VB6.

[archiifk]

Le principe est simple : analyser les mails d'une vue (id document lotus) pour y trouver des caracteristiques permettant de determiner leur appartenance à un meme groupe, et deplacement des mails correspondant dans un repertoire (deja existant) . comme cela on peut recherecher plusieurs identités dans emetteur, ou copie, ou encore un mot clef dans l'objet . Bref cela est parametrable , il suffit de completer les tabelaux ...

ce code va dans un agent de lotusnotes 8.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
'Declarations
 
	Dim Dbg As Boolean
 
	Dim session 	As notessession 	'Session
	Dim db 		As notesdatabase	'Base courante
	Dim doc 	As NotesDocument	'Document courant
	Dim ws 		As NotesUIWorkspace	'Vue courante
 
	'Vue courante
	Dim uiview 	As NotesUIView 		'vecteur graphique de la vue
	Dim nv 		As NotesView        	'contenu de la vue
	Dim view 	As NotesView      	'NOTESVIEW
 
	'Autres variables globales
	Dim Msg As String
	Dim nb As Integer
 
Sub Initialize
 
'Session courante
	Dim session As New notessession
'Vue courante
	Dim ws As New NotesUIWorkspace
 
'Switch du mode debug
	Dbg = False
 
'Instanciations	
	Set db=session.CurrentDatabase 		'Recuperation de la base courante
	Set uiview = ws.CurrentView 		'Récupération de la vue courante
	Set doc = session.DocumentContext
 
'Connexion sur la vue de boîte de réception
	nb = 0
	Form_Load("($INBOX)") 			'en passant inbox en variable on peut le faire saisir
 
	Msgbox "Nombre d'enregistrements traités : " & Cstr(nb)
	Msgbox "Dernier enregistrement traité : "  & Chr(13)+Chr(10)  & Chr(13)+Chr(10) & Msg
 
End Sub
 
 
Sub Terminate
	' vide	
End Sub
 
Private Sub Form_Load(analyselavue As String)
 
'Variables locales
	Dim i As Integer
	Dim j As Integer
	Dim k As Integer
	Dim n As Integer
	Dim nblu As Integer
	Dim Classer As Boolean
	Dim trouve As Boolean
	Dim champ_du_doc_a_tester As Variant	'tableau de taille indefinie et dont le type de contenu est indefini
 
	Set view = db.GetView(analyselavue)	'"($INBOX)" est passe en variable
 
	Set doc = view.GetFirstDocument		'Se placer sur le premier document	
 
	Classer = False
	nblu = 0
 
'Tant qu'il y a un document
	Do While Not doc Is Nothing
 
		'pour patienter afficher un message tout les 100 messages (buguer)
		nblu = nblu + 1
		If nblu < 100 Then
			If (nblu / 10) = 0 Then 
				Msgbox "lu : " & Cstr(nblu)
			End If	
		Else
			If (nblu / 100) = 0 Then 
				Msgbox "lu : " & Cstr(nblu)
			End If	
		End If	
 
 
	'On regarde l'expéditeur
		trouve = False
		If Instr(doc.GetFirstItem("From").Text, "toto@titi.fr") Then
			If Dbg Then Msgbox "trouve FROM , " & doc.GetFirstItem("From").Text
			trouve = True	
		End If
		' si le message a deja ete categorise
		If Instr(doc.GetFirstItem("Categories").Text, "CHORALE") Then
			If Dbg Then  Msgbox "trouve CAT , " & doc.GetFirstItem("categories").Text
			trouve = True	
		End If
		'sinon inspection des autres champs
		'initialisation des champ_du_doc_a_tester
		champ_du_doc_a_tester= AlimT_champ_du_doc_a_tester()     
		If recherche_cat ("CHORAL", champ_du_doc_a_tester, doc) Then 
			If Dbg Then  Msgbox "trouve CAT via la fonction recherche_cat" 
			trouve = True			
		End If
 
		If trouve Then
		  'Boite de dialogue pour voir les infos
			Msg = "Expéditeur : " & doc.GetFirstItem("From").Text & Chr(13)+Chr(10)
			Msg = Msg & "Expéditeur : " & doc.GetFirstItem("From").Text & Chr(13)+Chr(10)
			Msg = Msg & "Date  : " & doc.GetFirstItem("PostedDate").Text & Chr(13)+Chr(10)
			Msg = Msg & "Sujet : " & doc.GetFirstItem("Subject").Text & Chr(13)+Chr(10)
			'Msgbox "Corps du message : " & Replace(doc.GetFirstItem("Body").Text, vbCr, "")
			' bennn ! ca ca ne marche pas chez moi et je ne sais pas ce que cela fait
			If Dbg Then  Msgbox Msg
 
		   'On classe le mail
			moveToFolder db, doc, "Z.Personnel\Choral"
			nb = nb + 1		
			Classer = True
 
		End If
 
		If Classer = True Then			'Si l'enregistrement a ete classe (donc traité)
			If Dbg Then
				Goto endloop		'Si on est en mode debug, sortie au premier enregistrement traité
			End If
							'Si on vient de classer un mail, on reprend la lecture depuis le début
							'Comme on a classe le mail sélectionné, l'objet doc est dans les choux
			Set doc = view.GetFirstDocument	'recommencement de la boucle avec les restants dans la vue
			If doc Is Nothing Then Exit Do	'Si c'est vide on quitte la boucle
			Classer = False
 
		Else					'Si l'enregistrement n'a pas ete classe (car ne repondait pas aux criteres de recherche)
		Set doc = view.GetNextDocument(doc)
		End If
	Loop
 
 
	End
 
endloop:
End Sub
 
Function AlimT_champ_du_doc_a_tester( )	As Variant
	Dim Tb(0 To 100) As Variant	'tabelau de 100 occurences dont le type est indefini
 
	Tb(0) = "Sender"		'instanciation de la premiere occurence
	Tb(1) = "SMTPOriginator"	'instanciation de la seconde occurence
	Tb(2) = "SendTo" 		'instanciation de la troisieme occurence
	Tb(3) = "CopyTo"		'instanciation de la quatrieme occurence
	Tb(4) = "From"			'instanciation de la cinquieme occurence
	Tb(5) = "InetSendTo"
	Tb(6) = "InetCopyTo"
	Tb(7) = "INetFrom"
	Tb(8) = "In_Reply_To"
	Tb(9) = "AltSendTo"
	Tb(10) = "AltCopyTo"
	Tb(11) = "AltFrom"
	Tb(12) = "EnterSendTo"
	Tb(13) = "EnterCopyTo"
 
	AlimT_champ_du_doc_a_tester = Tb	'la fonction retourne le tableau rempli
End Function
 
Function recherche_cat (CCible As String, lchamp As Variant, doc As NotesDocument)	As Boolean
 
	Dim v As Variant	' tableau dont le type de contenu est indefini
	Dim longtab As Integer	' longueur du tableau
	Dim i As Integer	' indice de parcours du tableau v, des valeurs a rechercher pouvant correspondre a la categorie cible
	Dim j As Integer	' indice de parcours du tableau lchamp, passé en argument de la fonction
	Dim r As Boolean	' code retour del la fonction (vrai : element trouvé, Faux aucun element trouvé)
	Dim pos 		' position de la sous chaine recherchéé
	Dim debug As Boolean	' m^me si on est pas en mode debug, on peut tracer la fonction; bref un mode debug local
	Dim txtdebug As String
 
	debug = False
 
'Corps de la fonction	
	r=False 		'on n'a pas encore cherché, alors aucun element trouvé
 
	' alimentation du tableau des valeurs à rehercher en fonction de la valeur de la catégorie cible 
	' passée en argument de la fonction
 
	Select Case CCible
	Case "CHORAL"	: v=  AlimT_CHORAL
	Case "L.SYS"	: v=  AlimT_LSYS
	End Select
 
 
	If Not (Isarray(v)) Then			' si cela n'a pas marché, je n'ai pas un tableau
		If debug Then Msgbox "recherche_cat _ERROR _ Not (Isarray(v)) "
 
	Else
 
	longtab = iDimensionArray(v)				' recherche la longueur du tableau
	If debug Then Msgbox "recherche_cat_ longueur du tableau v trouvée : longtab = " + Cstr(longtab)
 
	If  longtab > 0 Then					'si l'indice est supérieur à 0 il s'agit d'un tableau
 
		j=0 						'initialisation de l'indice de parcours du tableau des noms des champ du document à parcourir
		While lchamp(j) <> "" 				'TQ1 : Tant qu'un champ du document à inspecter present dans le tableau
		Forall x In doc.GetItemValue(Cstr(lchamp(j))) 	'FOR1 : pour toutes les valeurs du champ document correspondant à l'orccurence du tableau lchamp courrante
			i=0 					'initialisation de l'indice de parcours du tableau des valeurs  correspondantes à la catégorie cible à rechercher
			While v(i) <> "" And x <> "" 		'TQ2 : Tant que il existe dans le tableau encore un element à rechercher  correspondantes à la catégorie cible
				pos = position_sous_chaine (x, Cstr(v(i)) ) 	  'recherche de la sous chaine correspondant à la valeur recherchee dans la chaine correpondant au champ du doc					
				txtdebug = Cstr(r)
				txtdebug = txtdebug + Chr(13) + Chr(10)
				txtdebug = txtdebug +" champ: "+Cstr(lchamp(j))
				txtdebug = txtdebug + Chr(13) + Chr(10)
				txtdebug = txtdebug + "appel fonction (position_sous_chaine (" + Cstr(x) + ", " +Cstr(v(i)) +"))"
				txtdebug = txtdebug + Chr(13) + Chr(10)
				txtdebug = txtdebug + "position : " + Cstr((position_sous_chaine (x, Cstr(v(i))  )))
				If debug Then Msgbox txtdebug
				If  pos > 0 Then  r=True	'VALEUR TROUVEE  => passage à true
				i=i+1 				'incrementation de l'indice de parcours TQ2
			Wend 					'fin TQ2
		End Forall 					'Fin FOR1
		j=j+1						'incrementation de l'indice de parcours TQ2
		Wend						'Fin TQ1  correspondant au tableau des champs du document à inspecter à la recherche de valeur correspondantes à la catégorie cible
 
 
	End If 							'fsi longtab > 0
 
	End If 							'fsi v est un tableau
 
	recherche_cat  = r
 
 
End Function
 
Function AlimT_CHORAL( ) As Variant
	Dim Tb(0 To 10) As Variant 
	Tb(0) = "toto@titi.fr"	
	Tb(1) = "taratata@titi.fr"	
	AlimT_CHORAL = Tb
End Function
 
'etc...   les autres procedures ont ete trouvees sur ce forum ...

merci pour m'avoir aider a finir ce sujet qui me taraude depuis deux ans

[sasafca]

Salut,

la méthode fonctionne pour déplacer les mails d'un dossier à l'autre dans la boite, mais comme faire pour déplacer les mails hors de Lotus, par exemple sur mon bureau en format.pdf ?

Merci !