Erreure execution pour envoi mail

Le 08/10/2016 à 14:28

bonjour a tous je suis décidément très embêté par ma fonction d'envoie de mail :

Sub replacename()
Feuil6.Visible = xlSheetVisible
Feuil6.Select
With Feuil6
If Range("E24").Value = "" Then
   Range("E24").Value = " aucune erreurs signalées"
If Range("E28").Value = "" Then
   Range("E28").Value = " aucune idées signalées"

savemaintenance replace(replace(Range("texte1").Value, "<erreurs>", .Range("E24")), "<idées>", .Range("E28"), "<code>", .Range("E19"))
End If
End If
End With
End Sub

Sub savemaintenance(texte As String)

Dim mMessage As Object
Dim mConfig As Object
Dim mChps

    Set mConfig = CreateObject("CDO.Configuration")

    mConfig.Load -1
    Set mChps = mConfig.Fields
    With mChps
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        'En principe, 25 fonctionne avec tout les serveurs.
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465

        'Vous pouvez essayer sans ces trois lignes
       'Mais si votre serveur demande une authentification,
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ".logistique@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "code"
        'Si votre serveur demande une connexion sûre (SSL)
       .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
        .Update
    End With

    Set mMessage = CreateObject("CDO.Message")
    With mMessage
    Set .Configuration = mConfig
        .To = Feuil6.Range("C12").Value
        .From = "@gmail.com"
        .Subject = "maintenance suivi demo  lorient"
        .htmlbody = "texte"
       .AddAttachment =
        'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
       '.AddAttachment 'Chemin et nom complet du fichier à joindre
       .Send
    End With
    Set mMessage = Nothing
    'Libère les ressources
   Set mConfig = Nothing
    Set mChps = Nothing

End If
End Sub

l’Erreur d’exécution se situe sur la première ligne surligner : savemaintenance replace(replace(Range("texte1").Value, "<erreurs>", .Range("E24")), "<idées>", .Range("E28"), "<code>", .Range("E19"))

mon deuxième soucis réside a la deuxième ligne surligner : .AddAttachment =

je souhaite que le fichier qui soit envoyer soit le plus récent des sauvegarde

"C:\Users\pourcel\Desktop\SAUVEGARDE DEMO" voila le chemin du fichier

"suivi des demandes de démo " & Format(Now, "dd-mm-yy--hh-mm-ss") & ".xlm" et voila comment est nomé le fichier

je vous remercie de votre aide .

cordialement roms .

Le 08/10/2016 à 15:01

bonjour,

proposition de correction

Sub replacename()
Feuil6.Visible = xlSheetVisible
Feuil6.Select
With Feuil6
 If Range("E24").Value = "" Then
  Range("E24").Value = " aucune erreurs signalées"
 End If
 If Range("E28").Value = "" Then
   Range("E28").Value = " aucune idées signalées"
 End If
 savemaintenance Replace(Replace(Replace(Range("texte1"), "<erreurs>", .Range("E24")), "<idées>", .Range("E28")), "<code>", .Range("E19"))
End With
End Sub

Sub savemaintenance(texte)

Dim mMessage As Object
Dim mConfig As Object
Dim mChps

Set mConfig = CreateObject("CDO.Configuration")

mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 'En principe, 25 fonctionne avec tout les serveurs.
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
 'Vous pouvez essayer sans ces trois lignes
 'Mais si votre serveur demande une authentification,
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ".logistique@gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "code"
 'Si votre serveur demande une connexion sûre (SSL)
 .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
 .Update
End With

Set mMessage = CreateObject("CDO.Message")
With mMessage
 Set .Configuration = mConfig
 .To = Feuil6.Range("C12").Value
 .From = "@gmail.com"
 .Subject = "maintenance suivi demo lorient"
 .htmlbody = "texte"
'recherche du fichier le plus récent
 f = Dir("C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\suivi des demandes de démo*.xlsm")
 While f <> ""
  If f > attach Then attach = f
  f = Dir()
 Wend
 If f <> "" Then
 .AddAttachment "C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\" & attach
 End If
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
 .Send
End With
Set mMessage = Nothing
'Libère les ressources
Set mConfig = Nothing
Set mChps = Nothing
End Sub

Le 08/10/2016 à 15:20

merci beaucoup pour votre aide le code ne me retourne pas de message erreur .

mais je ne recois pas le mail cela peut 'il venir du fait que mon répertoire de sauvegarde ne contienne pas encore le fichier ?

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call place
Dim Chemin As String, Fichier As String
Chemin = "C:\Users\pourcel\Desktop\SAUVEGARDE DEMO"
Fichier = "suivi des  demandes de démo " & Format(Now, "dd-mm-yy--hh-mm-ss") & ".xlm"
ActiveWorkbook.SaveCopyAs Chemin & Fichier
Application.Quit
End Sub

voila comment et éditer la sauvegarde de mon classeur le problème peut être de la

merci beaucoup .

Le 08/10/2016 à 15:39

roms30 a écrit :
merci beaucoup pour votre aide le code ne me retourne pas de message erreur .
mais je ne recois pas le mail cela peut 'il venir du fait que mon répertoire de sauvegarde ne contienne pas encore le fichier ?
merci beaucoup .

non, si le fichier n'existe pas, il ne sera pas mis en annexe.

Le 08/10/2016 à 15:58

non, si le fichier n'existe pas, il ne sera pas mis en annexe.[/quote]

je viens de changer l'adresse mail de destination cela fonctionne mais au lieu de me mettre le corps de massage il inique "texte".

"Bonjour,"" maintenance suivi demo hms lorient"" le fichier est bloquer pour l'utilisateur!!!!

erreurs rencontrées: ""<erreurs>"", idées d'améliorations: ""<idées>"" code de déverouillage: ""<code>"" .

Cordialement,

Le programme . "

voici le corps de texte qui devrait avoir les éléments entre parenthèse remplacer par la sub replacename .

si j'ai bien compris le fonctionnement ?

merci beaucoup de l'aide que vous me fournissez .

Le 08/10/2016 à 16:10

roms30 a écrit :
je viens de changer l'adresse mail de destination cela fonctionne mais au lieu de me mettre le corps de massage il inique "texte".

enlève les " dans l'instruction

 .htmlbody = "texte"

Le 08/10/2016 à 16:23

merci beaucoup c'était tel ment gros que je n'ais même pas pense a cela .

puis-je te demander juste une autre information sur ma sub :

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Chemin As String, Fichier As String
Chemin = "C:\Users\pourcel\Desktop\SAUVEGARDE DEMO"
Fichier = "suivi des  demandes de démo " & Format(Now, "dd-mm-yy--hh-mm-ss") & ".xlm"
ActiveWorkbook.SaveCopyAs (Chemin & Fichier)
Application.Quit
End Sub

car elle ne copie pas le classeur mais le code du classeur .

merci beaucoup pour le temps consacrer .

cordialement roms

Le 08/10/2016 à 17:03

rebonjour,

j'ai relevé quelques erreurs dans ce code, voici un correction

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim Chemin As String, Fichier As String
Chemin = "C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\"
Fichier = "suivi des demandes de démo " & Format(Now, "dd-mm-yy--hh-mm-ss") & ".xlsm"
ActiveWorkbook.SaveCopyAs (Chemin & Fichier)
Application.Quit
End Sub

pour le reste je ne comprends pas ce que tu veux dire par

car elle ne copie pas le classeur mais le code du classeur .

Le 08/10/2016 à 17:09

un énorme merci a vous pour votre aide .

le fichier sauvegarder un copie du code vba de mon classeur et non le classeur .

merci a vous je vous souhaite un excellent weekend .

cordialement rom's

désoler petit problème pour les mail , le fichier n'est pas joint lors de l'envoie je peut vous joindre mon fichier ??

Le 08/10/2016 à 17:31

Sub replacename()
Feuil6.Visible = xlSheetVisible
Feuil6.Select
With Feuil6
 If Range("E24").Value = "" Then
  Range("E24").Value = " aucune erreurs signalées"
 End If
 If Range("E28").Value = "" Then
   Range("E28").Value = " aucune idées signalées"
 End If
 savemaintenance replace(replace(replace(Range("texte1"), "<erreurs>", .Range("E24")), "<idées>", .Range("E28")), "<code>", .Range("E19"))
End With
End Sub

Sub savemaintenance(texte12 As String)

Dim mMessage As Object
Dim mConfig As Object
Dim mChps

Set mConfig = CreateObject("CDO.Configuration")

mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 'En principe, 25 fonctionne avec tout les serveurs.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
 'Vous pouvez essayer sans ces trois lignes
'Mais si votre serveur demande une authentification,
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = " .logistique@gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "code"
 'Si votre serveur demande une connexion sûre (SSL)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
 .Update
End With

Set mMessage = CreateObject("CDO.Message")
With mMessage
 Set .Configuration = mConfig
 .To = Feuil6.Range("C12").Value
 .From = ".logistique@gmail.com"
 .Subject = "maintenance suivi demo lorient"
 .htmlbody = "<FONT FACE='Calibri'>" & texthtml(texte12) & "</FONT>"
'recherche du fichier le plus récent
f = Dir("C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\suivi des demandes de démo*.xlsm")
 While f <> ""
  If f > Attach Then Attach = f
  f = Dir()
 Wend
 If f <> "" Then
 .AddAttachment  "C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\" & Attach
 End If
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
.Send
End With
Set mMessage = Nothing
'Libère les ressources
Set mConfig = Nothing
Set mChps = Nothing
End Sub

j'ai vu qu'il manquer égale mais cela ne fonctionne toujours pas ?

Le 09/10/2016 à 11:41

bonjour,

ajout de msgbox pour vérifier si un fichier à annexer est bien trouvé.

dis-moi ce qu'il affiche.

ps il ne faut pas de signe = dans la commande .addattachment

Sub replacename()
Feuil6.Visible = xlSheetVisible
Feuil6.Select
With Feuil6
 If Range("E24").Value = "" Then
  Range("E24").Value = " aucune erreurs signalées"
 End If
 If Range("E28").Value = "" Then
   Range("E28").Value = " aucune idées signalées"
 End If
 savemaintenance replace(replace(replace(Range("texte1"), "<erreurs>", .Range("E24")), "<idées>", .Range("E28")), "<code>", .Range("E19"))
End With
End Sub

Sub savemaintenance(texte12 As String)

Dim mMessage As Object
Dim mConfig As Object
Dim mChps

Set mConfig = CreateObject("CDO.Configuration")

mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 'En principe, 25 fonctionne avec tout les serveurs.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
 'Vous pouvez essayer sans ces trois lignes
'Mais si votre serveur demande une authentification,
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = " .logistique@gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "code"
 'Si votre serveur demande une connexion sûre (SSL)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
 .Update
End With

Set mMessage = CreateObject("CDO.Message")
With mMessage
 Set .Configuration = mConfig
 .To = Feuil6.Range("C12").Value
 .From = ".logistique@gmail.com"
 .Subject = "maintenance suivi demo lorient"
 .htmlbody = "<FONT FACE='Calibri'>" & texthtml(texte12) & "</FONT>"
'recherche du fichier le plus récent
f = Dir("C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\suivi des demandes de démo*.xlsm")
 While f <> ""
  If f > Attach Then Attach = f
  f = Dir()
 Wend
 If f <> "" Then
 msgbox "fichier attaché : " & attach
 .AddAttachment  "C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\" & Attach
else
 msgbox "pas de fichier trouvé à attacher"
 End If
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
.Send
End With
Set mMessage = Nothing
'Libère les ressources
Set mConfig = Nothing
Set mChps = Nothing
End Sub

Le 09/10/2016 à 12:20

bonjour , merci pour votre aide le msgbox me retourne : "pas de fichier trouvé à attacher".

pourtant le chemin du répertoire correspond bien .

merci beaucoup , roms

Le 09/10/2016 à 13:00

cela peut il venir du fait que le chemin mon fichier lors de son enregistrement soit comme cela :"C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\"

Fichier = "suivi des demandes de démo " & Format(Now, "dd-mm-yy--hh-mm-ss") & ".xlsm"

Le 09/10/2016 à 14:05

roms30 a écrit :
bonjour , merci pour votre aide le msgbox me retourne : "pas de fichier trouvé à attacher".
pourtant le chemin du répertoire correspond bien .
merci beaucoup , roms

et y a-t-il un fichier dont le nom commence par " suivi des demandes de démo" et qui se termine par "xlsm" dans ce répertoire ?

Le 09/10/2016 à 14:37

Oui il y en a 8 dans le dossier

Le 09/10/2016 à 16:28

une erreur dans le code que je t'ai fourni

Sub replacename()
Feuil6.Visible = xlSheetVisible
Feuil6.Select
With Feuil6
 If Range("E24").Value = "" Then
  Range("E24").Value = " aucune erreurs signalées"
 End If
 If Range("E28").Value = "" Then
   Range("E28").Value = " aucune idées signalées"
 End If
 savemaintenance replace(replace(replace(Range("texte1"), "<erreurs>", .Range("E24")), "<idées>", .Range("E28")), "<code>", .Range("E19"))
End With
End Sub

Sub savemaintenance(texte12 As String)

Dim mMessage As Object
Dim mConfig As Object
Dim mChps

Set mConfig = CreateObject("CDO.Configuration")

mConfig.Load -1
Set mChps = mConfig.Fields
With mChps
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
 'Adapter suivant votre serveur de mail. (exemple pour Gmail.)=> Hormail "smtp.live.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 'En principe, 25 fonctionne avec tout les serveurs.
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
 'Vous pouvez essayer sans ces trois lignes
'Mais si votre serveur demande une authentification,
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = "1"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = " .logistique@gmail.com"
 .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "code"
 'Si votre serveur demande une connexion sûre (SSL)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = "true"
 .Update
End With

Set mMessage = CreateObject("CDO.Message")
With mMessage
 Set .Configuration = mConfig
 .To = Feuil6.Range("C12").Value
 .From = ".logistique@gmail.com"
 .Subject = "maintenance suivi demo lorient"
 .htmlbody = "<FONT FACE='Calibri'>" & texthtml(texte12) & "</FONT>"
'recherche du fichier le plus récent
f = Dir("C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\suivi des demandes de démo*.xlsm")
 While f <> ""
  If f > Attach Then Attach = f
  f = Dir()
 Wend
 If attach <> "" Then
 msgbox "fichier attaché : " & attach
 .AddAttachment  "C:\Users\pourcel\Desktop\SAUVEGARDE DEMO\" & Attach
else
 msgbox "pas de fichier trouvé à attacher"
 End If
'Pour ajouter une pièce jointe, un fichier, classeur, image etc.
'.AddAttachment 'Chemin et nom complet du fichier à joindre
.Send
End With
Set mMessage = Nothing
'Libère les ressources
Set mConfig = Nothing
Set mChps = Nothing
End Sub

Le 09/10/2016 à 17:25

h2SO4 un énorme merci pour ton aide le fichier fonctionne a merveille .

votre aide est précieuse .

cordialement rom's

Rechercher des sujets similaires à "erreure execution envoi mail"