| 12
 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 | 
Partager