Recordset non fonctionnel pour envoi mail outlook via access

**dadou5821** · 28/10/2014, 13h41

Bonjour à tous,

Je me permet de vous soumettre une question concernant l'utilisation d'un recordset pour automatiser un envoi de mail spécifique à différentes personnes via Access.

Pour faire simple, j'ai une requête basé sur un formulaire continu qui va me sortir tous les enregistrements de produits qui arrivent à échéance dans x jours. L'idée est de cocher les enregistrements qui m’intéressent et d'envoyer un mail de rappel à chaque personne concernée par le rappel. En sachant que chaque mail envoyé sera spécifique dans la mesure où il reprendra la valeur de certains champs de l'enregistrement concerné. (vous êtes toujours là? ;-))

J'ai suivi beaucoup de tutoriels sur ces histoires d'automation entre outlook et access et j'ai construit mon code sur ces bases en l'adaptant à mon besoin :

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
 
Private Sub Outlook_Click()
 
  Dim MonOutlook As New Outlook.Application
  Dim MonMessage As Outlook.MailItem
  Dim rst As DAO.Recordset
  Dim strMessageType As String
  Dim strTitre As String
  Dim strMsg As String
 
 strTitre = "Echéance ATU {NomATU} pour {InitpatNOM}/{InitpatPRE} - Rappel"
 strMessageType = "Bonjour Docteur {Medecin}," _
    & vbCrLf & vbCrLf _
    & "L'ATU n°{NumeroATU} de {NomATU} pour le patient {InitpatNOM}/{InitpatPRE} arrive à échéance le {EcheanceATU}. " _
    & vbCrLf & vbCrLf & "Veuillez trouver ci-joint un formulaire à compléter et à nous retourner en cas de demande de renouvellement " & vbCrLf _
    & vbCrLf & vbCrLf & "Merci de préciser la tolérance et l'efficacité du médicament" _
    & vbCrLf & vbCrLf & "Cordialement," _
 
  ' Initialisation
  Set MonMessage = MonOutlook.CreateItem(0)
  strSQL = "SELECT * FROM [AlerteRelance]"
  Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
  While Not rst.EOF
    ' Construire un message personnalisé
    strTitre = Replace(strTitre, "{NomATU}", rst("NomATU"))
    strTitre = Replace(strTitre, "{InitpatNOM}", rst("InitpatNOM"))
    strTitre = Replace(strTitre, "{InitpatPRE}", rst("InitpatPRE"))
    strMsg = Replace(strMessageType, "{Medecin}", rst("Medecin"))
    strMsg = Replace(strMsg, "{NomATU}", rst("NomATU"))
    strMsg = Replace(strMsg, "{InitpatNOM}", rst("InitpatNOM"))
    strMsg = Replace(strMsg, "{InitpatPRE}", rst("InitpatPRE"))
    strMsg = Replace(strMsg, "{NumeroATU}", rst("NumeroATU"))
    strMsg = Replace(strMsg, "{EcheanceATU}", rst("EcheanceATU"))
 
 'Remplissage de l'objet MailItem
  MonMessage.To = rst("Mail")
  MonMessage.Subject = strTitre
  MonMessage.Body = strMsg
 
  'Expédier le mail
  MonMessage.Display
 
 ' Client suivant
  rst.MoveNext
  Wend
 
  ' Fermeture de la session Outlook et désallocation des objets
  rst.Close
  Set rst = Nothing
  Set MonOutlook = Nothing
 
MsgBox "Relances envoyées !", vbInformation, "Base ATU"
 
End Sub

Problème le recordset ne fonctionne pas.
J'ai bien la visualisation d'un mail avec les informations dedans mais je n'ai pas les suivants (dans le cas où plusieurs enregistrements sont sélectionnés pour un envoi mail)

Je suis sur qu'il y a une connerie toute bête dans le code qui bloque le déroulement de la procédure au delà du 1er enregistrement mais je n'arrive pas à trouver.

Merci par avance pour votre aide^^

**Thierry_PALLIER** · 29/10/2014, 15h15

Bonjour dadou5821.
Il est plus simple de séparer les choses.Dans une sub ,une boucle dans un recordset et dans une autre sub avec arguments, la commande qui envoie un mail pour chaque élément trouvé.
D'autre part avec "Dim MonMessage As Outlook.MailItem " ,je ne suis pas sur que celà crée un nouveau message.
Je pense qu'avec ce code (non testé), on doit s'approcher de la vérité.

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
Sub Outlook_Click()
    Dim rst As DAO.Recordset
    Dim strMessageType As String
    Dim strTitre As String
    Dim strMsg As String
    Dim AQui As String
 
    strTitre = "Echéance ATU {NomATU} pour {InitpatNOM}/{InitpatPRE} - Rappel"
    strMessageType = "Bonjour Docteur {Medecin}," _
                   & vbCrLf & vbCrLf _
                   & "L'ATU n°{NumeroATU} de {NomATU} pour le patient {InitpatNOM}/{InitpatPRE} arrive à échéance le {EcheanceATU}. " _
                   & vbCrLf & vbCrLf & "Veuillez trouver ci-joint un formulaire à compléter et à nous retourner en cas de demande de renouvellement " & vbCrLf _
                   & vbCrLf & vbCrLf & "Merci de préciser la tolérance et l'efficacité du médicament" _
                   & vbCrLf & vbCrLf & "Cordialement," _
 
' Initialisation
 
    strSQL = "SELECT * FROM [AlerteRelance]"
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
    With rst
        While Not rst.EOF
            ' Construire un message personnalisé
            strTitre = Replace(strTitre, "{NomATU}", rst("NomATU"))
            strTitre = Replace(strTitre, "{InitpatNOM}", rst("InitpatNOM"))
            strTitre = Replace(strTitre, "{InitpatPRE}", rst("InitpatPRE"))
            strMsg = Replace(strMessageType, "{Medecin}", rst("Medecin"))
            strMsg = Replace(strMsg, "{NomATU}", rst("NomATU"))
            strMsg = Replace(strMsg, "{InitpatNOM}", rst("InitpatNOM"))
            strMsg = Replace(strMsg, "{InitpatPRE}", rst("InitpatPRE"))
            strMsg = Replace(strMsg, "{NumeroATU}", rst("NumeroATU"))
            strMsg = Replace(strMsg, "{EcheanceATU}", rst("EcheanceATU"))
 
            AQui = rst!mail
 
            'commande l'envoie du mail
            Envoie_Message_dadou5821 strTitre, strMsg, AQui
 
            rst.MoveNext
        Wend
    End With
    ' Fermeture de la session Outlook et désallocation des objets
    rst.Close
    Set rst = Nothing
 
End Sub
 
 
Private Sub Envoie_Message_dadou5821(LeTitre As String, LeMessage As String, Destinataire As String)
 
    Dim MonOutlook As Object     'New Outlook.Application
    Dim MonMessage As Object    'Outlook.MailItem
    Set MonOutlook = New Outlook.Application    'avec reference outlook
'Set MonOutlook = CreateObject("Outlook.Application") 'sans reference outlook
    Set MonMessage = MonOutlook.CreateItem(olMailItem)
    'Remplissage de l'objet MailItem
    With MonMessage
        .To = Destinataire
        .Subject = LeTitre
        .Body = LeMessage
    End With
 
    'voir le mail
    MonMessage .Display
 
    'Expédier le mail
    '    MonMessage.Send
 
    ' Fermeture de la session Outlook et désallocation des objets
    Set MonOutlook = Nothing
 
    MsgBox "Relances envoyées !", vbInformation, "Base ATU"
 
End Sub

A+

**User** · 29/10/2014, 17h29

Bonsoir,

Il me semble qu'il y a aussi un problème au niveau des variables strTitle et strMsg qui devraient être réinitialisées à chaque passage de boucle.

Cdlt,
Denis

**Thierry_PALLIER** · 30/10/2014, 10h20

Bonjour le forum.
Effectivement ,User . Par paresse ,j'avais repris la partie du travail de dadou5821.
Du coup, la 1° sub devrait donner ceci:

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
Sub Outlook_Click()
    Dim rst As DAO.Recordset
    Dim strMessageType As String
    Dim strTitre As String
    Dim strMsg As String
    Dim AQui As String
 
    ' Initialisation
 
    strSQL = "SELECT * FROM [AlerteRelance]"
 
    With rst
        While Not rst.EOF
 
            ' Construire un message personnalisé
            strTitre = "Echéance ATU {" & rst!NomATU & "} pour {" & rst!InitpatNOM & "}/{" & rst!InitpatPRE & "} - Rappel"
            strMessage = "Bonjour Docteur {" & rst!Medecin & "}," _
                       & vbCrLf & vbCrLf _
                       & "L'ATU n°{NumeroATU} de {" & rst!NomATU & "} pour le patient {" & rst!InitpatNOM & "/{" & rst!InitpatPRE & "} arrive à échéance le {" & rst!EcheanceATU & "}. " _
                       & vbCrLf & vbCrLf & "Veuillez trouver ci-joint un formulaire à compléter et à nous retourner en cas de demande de renouvellement " & vbCrLf _
                       & vbCrLf & vbCrLf & "Merci de préciser la tolérance et l'efficacité du médicament" _
                       & vbCrLf & vbCrLf & "Cordialement,"
            'Debug.Print strMessage
 
            AQui = rst!mail
 
            'commande l'envoie du mail
            Envoie_Message_dadou5821 strTitre, strMsg, AQui
 
            rst.MoveNext
        Wend
    End With
    ' Fermeture de la session Outlook et désallocation des objets
    rst.Close
    Set rst = Nothing
 
End Sub

ps: j'ai laissé les accolades ,ne sachant pas à quoi elles sevent.
A+

**dadou5821** · 30/10/2014, 18h21

Bonsoir les gens^^,

Je ne reviens que maintenant et m'en excuse.

Merci énormément pour le temps passé sur ce cas. Vous vous en rendez peut être plus compte à force mais vos aides font incroyablement plaisir^^ Merci beaucoup.

J'ai testé vos propositions de solutions et ça fonctionne à merveille !!!!
J'ai supprimé la msgbox histoire que tous les mails s'affichent à l'écran d'un coup pour une dernière vérification avant envoi plutôt que de cliquer sur "Oui" pour faire afficher l'email suivant.

Par contre je n'ai pas de soucis pour la réinitialisation des champs strTitle et strMsg suite à la 1ère proposition de Thierry. Ces champs se "mettent" bien en fonction de l'enregistrement en question.
Le dernier code fourni ne m'affiche pas le contenu du mail par contre. mais c'est pas grave car la 1ère proposition réponds parfaitement au besoin.

J'ai également mis un fichier joint à chaque mail (.Attachments.Add "LOCALISATION FICHIER PDF") qui est systématique.

Par contre je ne sais pas s'il est possible d'ajouter un fichier spécifique selon le produit concerné par la relance mail (en plus du fichier systématique)?
-> En clair est ce qu'il est possible de mettre un chemin pour un fichier pdf dans ma table pour que lors du recordset il amène bien le fichier supplémentaire (s'il y en a un)?

J'ai vu qu'il y avait un type de champ "pièce jointe" dans les tables. J'ai vais essayer de voir ce que ça fait quand on l'appelle via le recordset comme pour mes autres champs. Je vous redis.

**Thierry_PALLIER** · 30/10/2014, 18h39

Tout est possible. Il suffit de mettre autant de ".Attachments.Add" qu'il y a de fichier à joindre
A+
penses à voter si la réponse t'as aidé.

**dadou5821** · 03/11/2014, 11h34

J'ai rajouté la variable Fichier dans le premier code comme ceci :

Dim Fichier As String
...
...
AQui = rst!Mail
Fichier = rst!DocPUT
...
...
'commande l'envoie du mail
Envoie_Message_dadou5821 strTitre, strMsg, AQui, Fichier
....
etc

Et dans le 2eme code :
Private Sub Envoie_Message_dadou5821(LeTitre As String, LeMessage As String, Destinataire As String, Fichier As String)

Dim MonOutlook As Object 'New Outlook.Application
Dim MonMessage As Object 'Outlook.MailItem
Set MonOutlook = New Outlook.Application 'avec reference outlook
'Set MonOutlook = CreateObject("Outlook.Application") 'sans reference outlook
Set MonMessage = MonOutlook.CreateItem(olMailItem)
'Remplissage de l'objet MailItem
With MonMessage
.To = Destinataire
.Subject = LeTitre
.Body = LeMessage
.Attachments.Add = Fichier 'Correspond au fichier/pièce jointe enregistrée dans la table principale de l'enregistrement appelé lors du recordset
.Attachments.Add "CHEMIN FICHIER CLASSIQUE SYSTEMATIQUE"

End With

'voir le mail
MonMessage.Display

'Expédier le mail
' MonMessage.Send

' Fermeture de la session Outlook et désallocation des objets
Set MonOutlook = Nothing

'MsgBox "Relances envoyées !", vbInformation, "Base ATU"

End Sub

Cependant lorsque je lance ma procédure, le débogueur me sort une erreur d’exécution '13' d'incompatibilité de type sur la ligne "Fichier = rst!DocPUT"
Dans le cas d'une pièce jointe ce n'est pas de cette façon qu'il faut l’écrire ?

**Thierry_PALLIER** · 03/11/2014, 13h10

Bonjour ,si Fichier represente bien un fichier valide et son chemin ,alors:

Code :

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

.Attachments.Add  Fichier

Le "=" est en trop.

Dans ta 1° sub ,quelle est la valeur renvoyée dans Fichier ( ou rst!....) ?
As-tu bien modifié ton recordset ?
A+

**dadou5821** · 04/11/2014, 10h04

Bonjour Thierry,

Ma variable Fichier renvoie bien à mon champ pièce jointe de ma table de telle manière :
Fichier = rst!DocPUT (DocPUT étant le nom de mon champ pièce jointe) et rst mon recordset

J'ai rajouté cette variable à mon 1er code de cette façon :
Sub Outlook2_Click()
Dim rst As DAO.Recordset
Dim strMessageType As String
Dim strTitre As String
Dim strMsg As String
Dim AQui As String
Dim Fichier As String

strTitre = "Echéance ATU {NomATU} pour {InitpatNOM}/{InitpatPRE} - Rappel"
strMessageType = "Bonjour Docteur {Medecin}," _
& vbCrLf & vbCrLf _
& "L'ATU n°{NumeroATU} de {NomATU} pour le patient {InitpatNOM}/{InitpatPRE} arrive à échéance le {EcheanceATU}. " _
& vbCrLf & vbCrLf & "Veuillez trouver ci-joint un formulaire à compléter et à nous retourner en cas de demande de renouvellement " & vbCrLf _
& vbCrLf & vbCrLf & "Merci de préciser la tolérance et l'efficacité du médicament" _
& vbCrLf & vbCrLf & "Cordialement," _

' Initialisation

strSQL = "SELECT * FROM [RelanceMail]"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
With rst
While Not rst.EOF
' Construire un message personnalisé
strTitre = Replace(strTitre, "{NomATU}", rst("NomATU"))
strTitre = Replace(strTitre, "{InitpatNOM}", rst("InitpatNOM"))
strTitre = Replace(strTitre, "{InitpatPRE}", rst("InitpatPRE"))
strMsg = Replace(strMessageType, "{Medecin}", rst("Medecin"))
strMsg = Replace(strMsg, "{NomATU}", rst("NomATU"))
strMsg = Replace(strMsg, "{InitpatNOM}", rst("InitpatNOM"))
strMsg = Replace(strMsg, "{InitpatPRE}", rst("InitpatPRE"))
strMsg = Replace(strMsg, "{NumeroATU}", rst("NumeroATU"))
strMsg = Replace(strMsg, "{EcheanceATU}", rst("EcheanceATU"))

AQui = rst!Mail
Fichier = rst!DocPUT

'commande l'envoie du mail
Envoie_Message_dadou5821 strTitre, strMsg, AQui, Fichier

rst.MoveNext
Wend
End With
' Fermeture de la session Outlook et désallocation des objets
rst.Close
Set rst = Nothing

End Sub

C'est peut être aussi dû au fait qu'il peut y avoir plusieurs pièces jointes associées à mon champ?

**Thierry_PALLIER** · 05/11/2014, 08h36

Bonjour dadou581.
Etant sous Access 2003, je ne connais pas le fonctionnement des champs pièces jointes.
Met un point d'arret sur la ligne "Fichier = rst!DocPUT" et regarde la valeur de rst!DocPUT.
Je ne peut rien faire de plus .
Cdlt

**dadou5821** · 06/11/2014, 10h56

Lorsqu'il bloque sur cette ligne, le mode débogage me met Fichier =""

Pour tous mes autres champs (texte, numérique, date etc) rst!Nomduchamp renvoie bien une valeur qui existe dans ma table.
Par contre rst!champ pièce jointe ne me renvoie rien.

J'ai fouillé un peu sur le net mais j'ai pas trouvé de méthode pour "renvoyer" un champ type pièce jointe

**dadou5821** · 15/12/2014, 15h01

J'ai essayé également Fichier = rst.Fields("Nom de mon champ piece jointe") mais rien n'y fait.

Je ne trouve rien sur le net à ce propos. Il doit bien être possible de faire une automation avec Outlook en prenant les documents contenus dans un champ pièce jointe.

Personne n'a idée?

Recordset non fonctionnel pour envoi mail outlook via access

VBA Access

Discussions similaires

Partager

Partager