Erreur 438 dans ma fonction

**Salsaboy60** · 13/02/2014, 01h11

Bonjour,

J'ai un souci avec ma fonction d'envoie de mail via gmail. Je n'arrive pas à inclure l'attachement.

J'ai trouvé ce code sur internet et initialement il étais écris en privé. Je l'ai fait public pour le faire appeler quand je veux. Tout fonctionne à merveille, sauf que maintenant que la fonction est public, je n'arrive plus à attacher un document.

J'ai transformé le chemin du document en string et j'obtient une message d'erreur code 438.

Voici 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
Public Function fSendGmail() As Boolean 'Returns True if No Errors are Generated
On Error GoTo Err_ErrorHandler
fSendGmail = True
 
Const conStrPrefix As String = "http://schemas.microsoft.com/cdo/configuration/"
Const conCdoSendUsingPort As Integer = 2    'If incorrect raises this Error: -2147220960
Const conCdoBasic As Integer = 1
Const conStrSmtpServer As String = "smtp.gmail.com"     'If incorrect raises this Error: -2147220973
Const conCdoSmtpUseSSL As Boolean = True    'Use Secure Sockets Layer (SSL) when posting via SMTP.
Const conCdoSmtpServerPort As Integer = 465 'Can be 465 or 587 'If incorrect raises this Error: -2147220973
 
Dim oMsg As Object
Dim oConf As Object
 
conSendPassword = DLookup("[Password]", "tbl_Société")
conSendUserName = DLookup("[email]", "tbl_Société")
 
'Create Objects
Set oMsg = CreateObject("CDO.Message")
Set oConf = CreateObject("CDO.Configuration")
Set oMsg.Configuration = oConf
 
'Build the Message
With oMsg
    .To = strEmailAddr       'If incorrect you will get an email From: Delivery Status Notification (Failure) Delivery to the following recipient failed permanently:
    .CC = ""
    .BCC = ""
    .FROM = strFrom    'If incorrect raises this Error: -2147220973
    .Subject = strSubject
    .TextBody = strBody
    .AddAttachment = strAttachement
End With
 
''Set Delivery Options
            With oConf.Fields
                .Item(conStrPrefix & "sendusing") = conCdoSendUsingPort
                .Item(conStrPrefix & "smtpserver") = conStrSmtpServer
                .Item(conStrPrefix & "smtpauthenticate") = conCdoBasic
                .Item(conStrPrefix & "sendusername") = conSendUserName
                .Item(conStrPrefix & "sendpassword") = conSendPassword
                .Item(conStrPrefix & "smtpusessl") = conCdoSmtpUseSSL
                .Item(conStrPrefix & "smtpserverport") = conCdoSmtpServerPort
                .Update 'Commit Changes
            End With
 
'Deliver the Message
oMsg.Send
 
Exit_ErrorHandler:
'Access 2007 Developer Reference > Microsoft Data Access Objects (DAO) Reference > DAO Reference > Recordset Object > Methods
'An alternative to the Close method is to set the value of an object variable to Nothing (Set dbsTemp = Nothing).
    Set oMsg.Configuration = Nothing
    Set oConf = Nothing
    Set oMsg = Nothing
    Exit Function
 
Err_ErrorHandler:
    If Err.Number <> 0 Then fSendGmail = False
        Select Case Err.Number
 
            Case -2147220977  'Likely cause, Incorrectly Formatted Email Address, server rejected the Email Format
                MsgBox "Error From --- fSendGmail --- Incorrectly Formatted Email ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "Format the Email Address Correctly"
 
            Case -2147220980  'Likely cause, No Recipient Provided (No Email Address)
                MsgBox "Error From --- fSendGmail --- No Email Address ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "You Need to Provide an Email Address"
 
            Case -2147220960 'Likely cause, SendUsing Configuration Error
                MsgBox "Error From --- fSendGmail --- The SendUsing configuration value is invalid --- LOOK HERE >>> sendusing) = conCdoSendUsingPort ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "SendUsing Configuration Error"
 
            Case -2147220973  'Likely cause, No Internet Connection
                MsgBox "Error From --- fSendGmail --- No Internet Connection ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "No Internet Connection"
 
            Case -2147220975  'Likely cause, Incorrect Password
                MsgBox "Error From --- fSendGmail --- Incorrect Password ---  Error Number >>>  " _
                & Err.Number & "  Error Desc >>  " & Err.Description, , "Incorrect Password"
 
            Case Else   'Report Other Errors
                MsgBox "Error From --- fSendGmail --- Error Number >>>  " & Err.Number _
                & "  <<< Error Description >>  " & Err.Description
        End Select
 
End Function      'fSendGmail

qqn un idée comment solutionner ce problème, ou pourquoi j'ai le problème?

J'ai controlé le string et il écrit bien "C:\XXXXX\Factures\F0123456.pdf", ce qui correspond au syntax souhaité, à mon avis. Est-ce que je me trompe?

Merci d'avance

Hans