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
| Option Compare Database
Option Explicit
Public Function fuRecMail(strSender As String, daReceivedTimeD As Date, daReceivedTimeF As Date)
On Error GoTo err_fuRecMail
'Déclaration des variables
Dim objOutlook As New Outlook.Application
Dim objOutlookAppt As Outlook.MailItem
Dim objOutlookMail As Outlook.Items
Dim objOutlookNameSpace As Outlook.NameSpace
Dim vaBody As Variant, vaReset As Variant
Dim i As Integer, j As Integer
Dim db As DAO.Database: Set db = CurrentDb
Dim rst As DAO.Recordset
Dim strSQL As String
'Ouverture du record
strSQL = "SELECT T_Mail.* FROM T_Mail;"
Set rst = db.OpenRecordset(strSQL)
'Ouverture objet Outlook
Set objOutlookNameSpace = objOutlook.GetNamespace("MAPI")
Set objOutlookMail = objOutlookNameSpace.GetDefaultFolder(olFolderInbox).Items
'Recherche les messages en provenance de l'adresse mail que tu as mis dans le formulaire
Set objOutlookAppt = objOutlookMail.Find("[SenderEmailAddress] = " & Chr(34) & strSender & Chr(34))
While TypeName(objOutlookAppt) <> "Nothing"
'Choix de la période
If objOutlookAppt.ReceivedTime >= daReceivedTimeD And objOutlookAppt.ReceivedTime < daReceivedTimeF Then
'On crée le tableau
vaBody = Split(objOutlookAppt.Body, Chr(10))
'On parcours le tableau
For i = 0 To UBound(vaBody)
'On test ligne par ligne pour trouver la première ligne qui a Numero
vaReset = Split(vaBody(i), ":", 2)
'Première ligne avec la mention Numero
If Trim(vaReset(0)) = "Numero" Then
rst.AddNew
'On ajoute un record
rst("NUMERO_MAIL") = vaReset(1)
rst("Date_Recu") = objOutlookAppt.ReceivedTime
j = i + 1
'On se positionne à la ligne suivante
'On parcours les lignes suivantes jusqu'a un autre Numero ou la fin du tableau
For j = j To UBound(vaBody) - 1
vaReset = Split(vaBody(j), ":", 2)
'Quand on a rencontre la deuxième série on sort de la boucle
If Trim(vaReset(0)) = "Numero" Then
Exit For
End If
'Sinon on ajoute les données
Select Case Trim(vaReset(0))
Case "Titre"
rst("Titre") = vaReset(1)
Case "Ville"
rst("Ville") = vaReset(1)
Case "Département"
rst("Departement") = vaReset(1)
Case "Date"
rst("Date_Event") = vaReset(1)
Case "Style"
rst("Style_Event") = vaReset(1)
Case "Age"
rst("Age") = vaReset(1)
Case "Budget"
rst("budget") = vaReset(1)
Case "Nom"
rst("Nom_Demandeur") = vaReset(1)
Case "Email"
rst("Mail_Demandeur") = vaReset(1)
Case "Téléphone"
rst("Phone_Demandeur") = vaReset(1)
Case "Commentaire"
rst("Commentaire") = vaReset(1)
End Select
Next j
'Sauvegarde le record
rst.Update
End If
err9:
Next i
End If
'On passe au mail suivant
Set objOutlookAppt = objOutlookMail.FindNext
Wend
'On libère les objets
rst.Close
Set rst = Nothing
Set db = Nothing
Set objOutlookAppt = Nothing
Set objOutlookMail = Nothing
Set objOutlookNameSpace = Nothing
err_fuRecMail:
Select Case Err.Number
Case 0
Exit Function
'Pas d'erreur
Case 9
Err.Number = 0
Resume err9
'Erreur qui se produit si pas de tableau
Case 3022
MsgBox "Impossible d'inscrire la commande # " & rst("NUMERO_MAIL") & Chr(13) & "Elle existe déjà!"
Resume Next
'Erreur qui se produit si le numéro est déjà inscrit, donc pas de sauvegarde et on continu
Case Else
MsgBox Err.Number & Err.Description
'Erreur autre
End Select
End Function |
Importation listing dans access
Répondre avec citation
Partager