Erreure execution pour envoi mail
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 .
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
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 .
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.
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 .
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"
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
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 .
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 ??
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 ?
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
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
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"
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 ?
Oui il y en a 8 dans le dossier
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
h2SO4 un énorme merci pour ton aide le fichier fonctionne a merveille .
votre aide est précieuse .
cordialement rom's