Prob Interaction ACCESS/OUTLOOK
Bonjour,
Je fais un publipostage mail vers outlook.
Mon code fonctionne mais il y a un comportement bizarre.
logiquement ca doit se passer comme cela :
Récupération du liste de destinataire pour alimenter le BCC du mail
Ajout d'une adresse mailling-list@maboite.fr au TO du mail.
sauvegarde du mail dans le dossier brouillons d'outlook pour modif avant envoi.
si outlook est fermé au moment de l'éxécution du code, cela fait nimporte quoi, le mail est collé dans la boite de réception, l'adresse To est manquante et meme parfois le mail n'existe carrément pas.
Pour palier à ce problème je fais une vérif sur la presence d'outlook ouvert, si celui n'est pas ouvert, le code l'ouvre et génére le mail. Là tout est ok sauf l'adresse To est manquante. Si je rééxécute aussitot le code la tout est parfait.
J'ai pensé à un problème de temporisation alors j'ai intercalé le code suivant :
Code:
1
2
3
4
5
| Dim i As Long
DoEvents
'cette boucle sert à créer une attente entre les deux affectations
For i = 1 To 1000000000
Next |
mais bon cela ne change rien. Pourquoi cela fait ca
Ci-dessous tout le code :
Code:
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
| Public Sub EnvoiMassif()
'Ajouter les références suivantes :
'Microsoft Outlook
'Microsoft DAO
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim oDB As DAO.Database
Dim strContenu As String
Dim oRst0 As DAO.Recordset
Dim oRst1 As DAO.Recordset
Dim strTo As String
Dim sqlMail As String
'evalue si outlook est ouvert
If IsOfficeRunning(App_outlook, True) Then
'Instancie Outlook
Set oDB = CurrentDb
Set oApp = CreateObject("Outlook.Application")
'Crée un nouveau message
'sqlMail = "SELECT * FROM tblMessage;"
'Set oRst0 = oDB.OpenRecordset(sqlMail)
'oRst0.MoveLast
Set oMail = oApp.CreateItem(olMailItem)
oMail.Body = "Tapez votre message ici" 'oMail.Body = oRst0.Fields("txtcorps")
oMail.Subject = "MAILLING : Tapez le sujet du message" 'oRst0.Fields("strObjet") & " du " & oRst0.Fields("dtCrea")
'Ouvre un recordset sur les clients
If strFiltreallpub = Empty Then
Set oRst1 = oDB.OpenRecordset("SELECT mail1 FROM Tb_contacts")
Else
Set oRst1 = oDB.OpenRecordset("SELECT mail1 FROM Tb_contacts WHERE" & strFiltreallpub)
End If
'Boucle sur chaque client et les ajoute au champ BCC du mail
While Not oRst1.EOF
strTo = strTo & oRst1.Fields("mail1") & "; "
oRst1.MoveNext
Wend
'Supprime la dernière virgule
oMail.BCC = Left(strTo, Len(strTo) - 2)
oMail.To = "Mailling-list@maboite.fr"
'Envoi du mail
oMail.Save
'oMail.Display
'oRst0.Close
oRst1.Close
Set oRst0 = Nothing
Set oRst1 = Nothing
Set oDB = Nothing
'Ferme Outlook
'oApp.Quit
Set oApp = Nothing
MsgBox "Le mail à été placé dans le dossier brouillons de votre outlook", vbInformation
Else
Dim stAppName As String
stAppName = "C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE"
Call Shell(stAppName, 1)
Dim i As Long
DoEvents
'cette boucle sert à créer une attente entre les deux affectations
For i = 1 To 1000000000
Next
'Instancie Outlook
Set oDB = CurrentDb
Set oApp = CreateObject("Outlook.Application")
'Crée un nouveau message
'sqlMail = "SELECT * FROM tblMessage;"
'Set oRst0 = oDB.OpenRecordset(sqlMail)
'oRst0.MoveLast
Set oMail = oApp.CreateItem(olMailItem)
oMail.Body = "Tapez votre message ici" 'oMail.Body = oRst0.Fields("txtcorps")
oMail.Subject = "MAILLING : Tapez le sujet du message" 'oRst0.Fields("strObjet") & " du " & oRst0.Fields("dtCrea")
'Ouvre un recordset sur les clients
If strFiltreallpub = Empty Then
Set oRst1 = oDB.OpenRecordset("SELECT mail1 FROM Tb_contacts")
Else
Set oRst1 = oDB.OpenRecordset("SELECT mail1 FROM Tb_contacts WHERE" & strFiltreallpub)
End If
'Boucle sur chaque client et les ajoute au champ BCC du mail
While Not oRst1.EOF
strTo = strTo & oRst1.Fields("mail1") & "; "
oRst1.MoveNext
Wend
'Supprime la dernière virgule
oMail.BCC = Left(strTo, Len(strTo) - 2)
oMail.To = "Mailling-list@maboite.fr"
'Envoi du mail
oMail.Save
'oMail.Display
'oRst0.Close
oRst1.Close
Set oRst0 = Nothing
Set oRst1 = Nothing
Set oDB = Nothing
'Ferme Outlook
'oApp.Quit
Set oApp = Nothing
MsgBox "Le mail à été placé dans le dossier brouillons de votre outlook", vbInformation
End If
End Sub |
