Prob Interaction ACCESS/OUTLOOK

**sebinator** · 11/11/2007, 15h43

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 :

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

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 :

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

**imsse** · 12/11/2007, 12h05

jai exactement le meme code que toi pour envoyer un mail outlook via acess mais aurais tu une idéé pouquoi mon code bloque a cette ligne avec lerreur "echec dapllication "

Code :

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

Set oMail = oApp.CreateItem(olMailItem)

merci

**sebinator** · 12/11/2007, 23h51

Envoyé par imsse

jai exactement le meme code que toi pour envoyer un mail outlook via acess mais aurais tu une idéé pouquoi mon code bloque a cette ligne avec lerreur "echec dapllication "

Code :

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