Discussion :

[sasafca]

Bonjour,
voila je dois extraire tous les mails contenu dans Lotus Notes.
J'ai réussi à adapter mon grâce à ceci:
http://www.developpez.net/forums/d60...c-lotus-notes/

Cependant, ce code permet de déplacer des mails dans d'autres dossiers de Lotus. Alors que je voudrai les extraire de Lotus (si possible au format PDF) vers mon bureau.
Voici donc le code:

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

Il faut modifier la fonction moveToFolder je pense,

Code :

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

docMailBoxCopy.PutInFolder folderName, True

mais je ne trouve pas la fonction qui permettrai de déplacer vers mon bureau.

Si quelqu'un connait la solution.

Merci !!

[sasafca]

Est-ce que la référence PDFCreator pour m'aider ? Car dans lotus pour extraire les mails en PDF il faut faire:
Imprimer -> Extraire avec PDFCreator

Merci de l'aide