envoi mail avec pièce jointe erreur d'execution"13" incompatibilité de type

**grib1903** · 11/07/2016, 16h02

bonjour,
après des heures de recherches je me tourne à nouveau vers vous
car sous access 2010 j'ai un formulaire qui après ma requête anniversaire me permettrait d'envoyer un mail
seulement je dois avoir une erreur qui se situe au niveau de ma pièce jointe (car quand il n'y en a pas, l'erreur n'est plus)

le code du module "SendOLmail3"

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
Option Compare Database
' ---
' ENVOYER UN MAIL DEPUIS ACCESS
' ---
' Entrée : strEmail <- Adresse e-mail du destinataire
'          strObj   <- Objet du courrier
'          strMsg   <- Corps du message
'          blnEdit  <- True pour pouvoir modifier le courrier avant envoi
'                      False pour expédier le courrier directement.
 
' Remarques : Le mail est expédié via Microsoft Outlook
'             plutôt que via SendObject.
 
Public Sub SendOLMail( _
 ByVal strEmail As String, _
  ByVal strCopy As String, _
  ByVal strObj As String, _
  ByVal strMsg As String, _
  ByVal blnEdit As Boolean, _
  Optional ByVal avarFichiers As Variant)
 
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
 
' Créer une instance d'Outlook
On Error GoTo OLMailErr
Set ol = New Outlook.Application
 
' Créer un objet Email
Set mi = ol.CreateItem(olMailItem)
 
' Paraméter le message
With mi
  .To = strEmail
  .Subject = strObj
  .HTMLBody = strMsg
  .HTMLBody = olFormatHTML
   ' Joindre les pièces, s'il y en a
  For Each varPJ In avarFichiers
    .Attachments.Add (varPJ)
  Next
 
 
  If blnEdit Then
    .Display
  Else
    .Send
  End If
End With
 
Set mi = Nothing
Set ol = Nothing
Exit Sub
 
OLMailErr:
    MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
    Exit Sub
End Sub

et celui du bouton dans mon formulaire

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
Option Compare Database
 
Private Sub btnEmail_Click()
Dim rst As DAO.Recordset
  Dim strSQL As String
  Dim strMessageType As String
  Dim strTitre As String
  Dim strMsg As String
  Dim astrFichiers(1 To 1) As String
 
' Chemin des fichiers à joindre
astrFichiers(1) = "C:\Test reduction.docx"
 
 
  ' Titre du message
  strTitre = "Joyeux Anniversaire- Société GROGNON"
 
  ' Message type à expédier
  ' Les signes {...} seront remplacés plus loin par
  ' les infos Client
  strMessageType = "Bonjour <b>{Civilité} {Prénom} {Nom}</b>," _
    & vbCrLf & vbCrLf _
    & "Le {Date_naissance}, ce sera votre Anniversaire ! " _
    & vbCrLf & vbCrLf _
    & "En cette occasion," _
    & vbCrLf & vbCrLf _
    & "Ambiances Créatives" _
    & vbCrLf & vbCrLf _
    & "est heureuse de vous offrir," _
    & vbCrLf & vbCrLf _
    & "20% de réduction sur l'ensemble de la boutique!." _
    & vbCrLf & vbCrLf _
    & vbCrLf & "Vous souhaitant encore un Joyeux Anniversaire ! :-)" _
    & vbCrLf & vbCrLf & "-- Société GROGNON."
 
  astrFichiers(1) = "C:\Test reduction.docx"
 
  ' Ouverture de la requête
  ' (seuls les clients ayant un email sont concernés ici)
  strSQL = "SELECT * FROM [R_anniversaire]" _
    & " WHERE [Email] IS NOT NULL"
  Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
 
  ' Parcourir la liste des clients
  While Not rst.EOF
    ' Construire un message personnalisé
    ' (on remplace chaque {...} du message par les champs
    ' équivalents de la requête
    strMsg = Replace(strMessageType, "{Civilité}", rst("Civilité"))
    strMsg = Replace(strMsg, "{Nom}", rst("Nom"))
    strMsg = Replace(strMsg, "{Prénom}", rst("Prénom"))
    strMsg = Replace(strMsg, "{Date_naissance}", rst("Date_naissance"))
 
 
 
    ' Expédier le mail
    SendOLMail rst("Email"), strTitre, strMsg, False, astrFichiers(1)
    astrFichiers(1) = "C:\Test reduction.docx"
    ' Client suivant
    rst.MoveNext
  Wend
 
  ' On libère les ressources
  rst.Close
  Set rst = Nothing
 
  ' Un petit message de confirmation
  MsgBox "Opération terminée !", vbInformation, "Mail de Société GROGNON"
 
End Sub
 
Private Sub Form_Open(Cancel As Integer)
 ' Annuler l'ouverture du formulaire de rappel
  ' si la requête qui l'alimente ne contient
  ' aucune ligne
  If Me.RecordsetClone.RecordCount = 0 Then
    Cancel = True
  End If
 
End Sub

j'ai une erreur sur la ligne SendOLmail 'expédier le mail
cette erreur dit "erreur d'execution "13" incompatibilité de type

pourriez-vous m'aider ?

merci d'avance !

**Jean-Philippe André** · 11/07/2016, 16h12

Salut,

comme ton code attend un variant qui sera parcouru, j'aurais opte pour modifie le code et passer non pas une valeur mais un tableau lors de l'appel :

Code :

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

SendOLMail rst("Email"), strTitre, strMsg, False, astrFichiers(1)

devenant

Code :

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

SendOLMail rst("Email"), strTitre, strMsg, False, astrFichiers

**grib1903** · 11/07/2016, 16h18

quand je mets ça il me dit "erreur de compilation incompatibilité de type"

**grib1903** · 17/07/2016, 13h06

personne n'a une idée pour corriger mon erreur ?
merci d'avance pour votre aide !

Invité · 17/07/2016, 23h18

Bonsoir,
http://www.developpez.net/forums/d14...t/#post7968025

**grib1903** · 18/07/2016, 19h30

Pour ceux que ça intéresse , j'ai trouvé la solution en m'aidant de http://www.developpez.net/forums/d12...cutercode-vba/:

code du module d'envoi mail (avec mise en forme HTML:

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
Public Function SendOLMail2( _
                            ByVal strEmail As String, _
                            ByVal strObj As String, _
                            ByVal strMsg As String, _
                            ByVal blnEdit As Boolean, _
                            Optional ByVal avarFichiers As Variant)
 
 
Dim ol As Outlook.Application
Dim mi As Outlook.MailItem
Dim varPJ As Variant
 
On Error GoTo OLMailErr
 
Set ol = New Outlook.Application
Set mi = ol.CreateItem(olMailItem)
With mi
    .To = strEmail
    .Subject = strObj
  .HTMLBody = strMsg & "<br>" & "<div>" & "<b>" & "<p>" & "<FONT COLOR=#3333FF>" & "<i>" & .HTMLBody
 
    For Each varPJ In avarFichiers
        .Attachments.Add (varPJ)
    Next
    If blnEdit Then
       .Display
    Else
       .Send
    End If
End With
Set mi = Nothing
Set ol = Nothing
Exit Function
 
OLMailErr:
MsgBox "Erreur : " & Err.Number & vbCrLf & Err.Description
Exit Function
End Function

code à intégrer au bouton d'envoi mail

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
Option Compare Database
 
Private Sub btnEmail_Click()
Dim rst As DAO.Recordset
  Dim strSQL As String
  Dim strMessageType As String
  Dim strTitre As String
  Dim strMsg As String
  Dim astrFichiers(1 To 1) As String
 
 
 
 
 
 
  ' Titre du message
  strTitre = "Joyeux Anniversaire- de la part de N'est plus Grognon"
 
  ' Message type à expédier
  ' Les signes {...} seront remplacés plus loin par
  ' les infos Client
  strMessageType = "<FONT COLOR=#3333FF>Bonjour <b>{Prénom} {Nom}</b>," _
           & "<p><br /></p> " _
            & "<p><div>Le <b>{Date_naissance}</b>, ce sera <b>Votre Anniversaire ! </div></b></p>" _
        & "<p>En cette occasion,</p>" _
    & vbCrLf & vbCrLf _
    & "<p><b><i>N'est plus Grognon</i></b>est heureuse de vous offrir <b>20% de réduction </b>sur l'ensemble de la boutique !.</p>" _
    & vbCrLf & vbCrLf _
    & vbCrLf & "<p>Vous souhaitant encore un Joyeux Anniversaire ! :-)</p>" _
    & vbCrLf & vbCrLf & "<p><div><b><i>-- N'est plus Grognon.</i></b></div></Font></p>"
 
 astrFichiers(1) = "C:\Test_reduction"
 
 
  ' Ouverture de la requête
  ' (seuls les clients ayant un email sont concernés ici)
  strSQL = "SELECT * FROM [R_anniversaire]" _
    & " WHERE [Email] IS NOT NULL"
  Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot)
 
  ' Parcourir la liste des clients
  While Not rst.EOF
    ' Construire un message personnalisé
    ' (on remplace chaque {...} du message par les champs
    ' équivalents de la requête
    strMsg = Replace(strMessageType, "{Civilité}", rst("Civilité"))
    strMsg = Replace(strMsg, "{Nom}", rst("Nom"))
    strMsg = Replace(strMsg, "{Prénom}", rst("Prénom"))
    strMsg = Replace(strMsg, "{Date_naissance}", rst("Date_naissance"))
  astrFichiers(1) = "C:\Test_reduction.txt"
 
 
 
    ' Expédier le mail
   SendOLMail2 rst("Email"), strTitre, strMsg, False, astrFichiers
astrFichiers(1) = "C:\Test_reduction.txt"
 
 
    ' Client suivant
    rst.MoveNext
  Wend
 
  ' On libère les ressources
  rst.Close
  Set rst = Nothing
 
  ' Un petit message de confirmation
  MsgBox "Message Envoyé ! Opération terminée !", vbInformation, "N'est plus Grognon"
 
End Sub
 
Private Sub Form_Open(Cancel As Integer)
 ' Annuler l'ouverture du formulaire de rappel
  ' si la requête qui l'alimente ne contient
  ' aucune ligne
  If Me.RecordsetClone.RecordCount = 0 Then
    Cancel = True
  End If
 
End Sub

en espérant que ça vous aidera, car moi, j'ai bien galéré !

envoi mail avec pièce jointe erreur d'execution"13" incompatibilité de type [AC-2010]

VBA Access

Discussions similaires

Partager

Partager