Bonjour,
Je veux envoyer automatiquement un fichier joint dans un mail en CDO.
J'utilise une code que j'ai trouvé sur internet :
.AddAttachment et nom du chemin de mon fichier. Il y a toujours une erreur : le chemin d'accès est introuvable.
J'ai tout essayé je ne trouve rien, pourtant la syntaxe me semble correcte.
Ou se trouve le problème ?
Merci
Cordialement
J.J Martin
sub envoi_mail()
Application.ScreenUpdating = False
Dim iMsg As Object, iConf As Object, Flds As Object
Dim strHTML As String
Dim Fichier As Variant
Dim email As String
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
email = Range("C13")
If Worksheets("page_accueil").Range("N8") > 0 Then
email = Range("C13") & ";" & Worksheets("page_accueil").Range("N8")
End If
If Worksheets("page_accueil").Range("N9") > 0 Then
email = Range("C13") & ";" & Worksheets("page_accueil").Range("N8") & ";" & Worksheets("page_accueil").Range("N9")
End If
If Worksheets("page_accueil").Range("N10") > 0 Then
email = Range("C13") & ";" & Worksheets("page_accueil").Range("N8") & ";" & Worksheets("page_accueil").Range("N9") & ";" & Worksheets("page_accueil").Range("N10")
End If
Range("A30") = email
strHTML = ""
strHTML = strHTML & "<HEAD>"
strHTML = strHTML & "<BODY>"
strHTML = strHTML & "Bonjour," & "<BR> <BR>Veuillez trouver ci-joint le fichier des inscriptions des joueurs du SCBC42 pour le tournoi de :" & "<B><u>" & Range("C3") & "</B></u>" & "<BR>L'inscription papier et le chèque partent aujour'hui au courrier." & "<BR><B>Merci de confirmer la bonne réception du message et du fichier ." & "</B>"
strHTML = strHTML & "<BR><BR>Cordialement<BR><BR>" & Range("C17") & "<BR>"
strHTML = strHTML & "</BODY>"
strHTML = strHTML & ""
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.sfr.fr"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Update
End With
With iMsg
Set .Configuration = iConf
.To = Range("A30") 'Renvoie une erreur si l'adresse est non valide"
'.From = "youralias@yourdomain.com"
.From = Worksheets("page_accueil").Range("I9")
.cc = "martinjeanjacques42@gmail.com" & ";" & Worksheets("page_accueil").Range("I9")
.Subject = "Envoi Feuille d'inscription"
'.AddAttachment Fichier
[color=#FF0000] .AddAttachment "(C:\Users\NomOrdinateur\Downloads\scbc42\inscriptions\30092013_Genas.pd)f"[/color]
.HTMLBody = strHTML
.Send
End With
Set iMsg = Nothing
Application.ScreenUpdating = True
MsgBox "Traitement 5 terminé", vbInformation, "Sauvegarde - Envoi mail"
Application.ScreenUpdating = True
End Sub