Probleme avec fonction .SEND
Salut
La macro suivante fonctionne parfaitement et est censée envoyer par email le premier onglet (general) à une adresse email qu'on écrit dans une inputbox.
Lorsque le code est avec "display", l'email s'affiche correctement, cependant pour un raison inconnue en changeant avec "Send" afin qu'il soit envoyé directement, le mail n'est pas envoyé.
J'ai regardé dans le courrier sortant de ma boite email (Outlook 2016) et rien n'a été envoyé! Le destinataire aussi n'a rien reçu bien entendu..
Quelqu'un saurait-il pourquoi la macro fonctionne avec Display mais pas avec Send ??
C'est vraiment bizarre.
Voici le code complet:
Sub Mail_Range() ' SEND BY EMAIL RANGE FROM GENERAL
Call Get_Data
'Working in Excel 2000-2016
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddress As String
Dim LastRow As Long
EmailAddress = InputBox("Veuillez entrer l'adresse email à laquelle vous souhaitez envoyer la rooming list", "Adresse email")
If EmailAddress = "" Then
MsgBox "Vous devez préciser un email pour l'envoi. L'action est interrompue", vbOKOnly, "Entrée invalide"
Exit Sub
Else
End If
If InStr(EmailAddress, "@") = 0 Then
MsgBox "Adresse email invalide. Action interrompue!", vbOKOnly, "Adresse invalide"
Exit Sub
Else
End If
Msg = "Etes-vous certain(e) de vouloir envoyer cette rooming list à l'email suivant:" & " " & EmailAddress & " " & "? (L'hôtel recevra en pièce jointe les données contenues dans l'onglet général sans le PNR ni la remarque sur le règlement.)"
Dialogstyle = vbQuestion + vbYesNo
Title = "Verification avant envoi"
RESPONSE = MsgBox(Msg, Dialogstyle, Title)
If RESPONSE = vbNo Then
Exit Sub
End If
If RESPONSE = vbYes Then
End If
ActiveSheet.Unprotect "obrat"
Columns("J").EntireColumn.Hidden = True
Columns("L").EntireColumn.Hidden = True
Set Source = Nothing
On Error Resume Next
LastRow = WorksheetFunction.Max(17, Range("B" & Rows.Count).End(xlUp).Row)
Set Source = Range("A1:S" & LastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
'TempFileName = wb.Name
TempFileName = Range("B1") & " " & Range("C1")
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = EmailAddress
.CC = ""
.BCC = ""
.Subject = Range("B1") & " " & Range("C1")
.Body = "Hey!" & Chr(10) & Chr(10) & "Please find in attachment the rooming list." & Chr(10) & Chr(10) & "Best regards," & Chr(10) & Chr(10) & Application.UserName & " " & "-" & " " & "Obrat Tours"
.Attachments.Add Dest.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
Columns("J").EntireColumn.Hidden = False
Columns("L").EntireColumn.Hidden = False
ActiveSheet.Protect "obrat", True, True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Bonjour,
1) as-tu essayé de lancer ta macro après avoir supprimé l'instruction
on error resume next?
il est probable que ta macro rencontre une erreur mais cette instruction demande de l'ignorer, Cette erreur si erreur il y a pourrait expliquer pourquoi le mail n'est pas envoyé.
2) autre piste, lorsque tu gardes l'instruction display, le mail te semble-t-il correct ? (destinataire, sujet, pièce jointe ). L'envoi de ce mail via outlook fonctionne-t-il ?
je corrigé ma réponse
en enlevant, ça marche!
merci!
non.. en fait ça ne marche pas
je reçois un bug : "outlook do not recognize one or more names."
et il me signale en jaune le ".send"
Par contre quand je change en .display, tout fonctionne bien.
C'est trop bizarre!!
voici le code:
Sub Mail_Range() ' SEND BY EMAIL RANGE FROM GENERAL
'Working in Excel 2000-2016
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Dim EmailAddress As String
Dim LastRow As Long
EmailAddress = InputBox("Veuillez entrer ci-dessous l'adresse email à laquelle vous souhaitez envoyer la rooming list. (L'hôtel recevra en pièce jointe les données contenues dans l'onglet général sans le PNR ni la remarque sur le règlement.)", "Adresse email")
If EmailAddress = "" Then
MsgBox "Vous devez préciser un email pour l'envoi. Action interrompue!", vbOKOnly, "Entrée invalide"
Exit Sub
Else
End If
If InStr(EmailAddress, "@") = 0 Then
MsgBox "Adresse email invalide. Action interrompue!", vbOKOnly, "Adresse invalide"
Exit Sub
Else
End If
Msg = "Etes-vous certain(e) de vouloir envoyer cette rooming list à l'email suivant:" & " " & EmailAddress & " " & "?"
Dialogstyle = vbQuestion + vbYesNo
Title = "Verification avant envoi"
RESPONSE = MsgBox(Msg, Dialogstyle, Title)
If RESPONSE = vbNo Then
Exit Sub
End If
If RESPONSE = vbYes Then
End If
ActiveSheet.Unprotect "obrat"
Columns("J").EntireColumn.Hidden = True
Columns("L").EntireColumn.Hidden = True
Set Source = Nothing
'COPIER DERNIERE LIGNE APRES LIGNE 17
LastRow = WorksheetFunction.Max(17, Range("B" & Rows.Count).End(xlUp).Row)
Set Source = Range("A1:S" & LastRow).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
'TempFileName = wb.Name
TempFileName = Range("B1") & " " & Range("C1")
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
'On Error Resume Next
OutMail.SentOnBehalfOfName = "me@myemail.com"
With OutMail
.To = EmailAddress
.CC = ""
.BCC = ""
.Subject = Range("B1") & " " & Range("C1")
.Body = "Hey!" & Chr(10) & Chr(10) & "Please find in attachment the rooming list." & Chr(10) & Chr(10) & "Best regards," & Chr(10) & Chr(10) & Application.UserName & " " & "-" & " " & "Tours"
.Attachments.Add Dest.FullName
.Send
End With
' On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
Columns("J").EntireColumn.Hidden = False
Columns("L").EntireColumn.Hidden = False
ActiveSheet.Protect "obrat", True, True
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Bonjour,
eh bien tu as l'explication
je reçois un bug : "outlook do not recognize one or more names."
un ou plusieurs noms de destinataire n'est pas valable.
le problème est dans tes données, pas dans la macro.
mais il montre le mot ".Send"
avec display ça fonctionne.
Et l'email apparait comme il faut.
En général si une macro avec display fonctionne elle devrait fonctionner également si on change en ".Send"...
Si le problème est dans mes données , alors pourquoi la macro fonctionne avec Display mais pas avec Send- avec les mêmes données dans les deux cas...?
J'ai trouve le probleme.
En enlevant: OutMail.SentOnBehalfOfName = "me@myemail.com"
la macro fonctionne avec .Send
mais il montre le mot ".Send"
avec display ça fonctionne.
Et l'email apparait comme il faut.
En général si une macro avec display fonctionne elle devrait fonctionner également si on change en ".Send"...
Si le problème est dans mes données , alors pourquoi la macro fonctionne avec Display mais pas avec Send- avec les mêmes données dans les deux cas...?
le nom du destinataire est validé lors de l'envoi et pas lors du display
mais maintenant il faut que je trouve un moyen de choisir de quelle adresse email ce sera envoyé
Bonjour
si tu veux l'envoyer avec outlook, tu ne pourras l'envoyer qu'à partir d'un des comptes associés ou délégués à l'utilisateur d'outlook actif sur cette machine.
Bonjour,
J'ai un peu modifié la macro et chez moi, ça fonctionne.
En enlevant: OutMail.SentOnBehalfOfName = "me@myemail.com"
la macro fonctionne avec .Send
je suis assez surpris car chez moi même en laissant cette ligne de code, ça fonctionne d'autant plus que cette propriété ne fait qu'apparaître le nom ou toute autre valeur de l'expéditeur !
Extrait de l'aide :
"Renvoie une valeur de type String qui indique le nom complet de l'expéditeur initial du message électronique. Lecture-écriture."
OutMail.SentOnBehalfOfName = "me@myemail.com"Sub Mail_Range()
Dim Source As Range
Dim Dest As Workbook
Dim OutApp As Object
Dim OutMail As Object
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim EmailAddress As String
Dim LastRow As Long
Dim FileFormatNum As Long
EmailAddress = InputBox("Veuillez entrer ci-dessous l'adresse email à laquelle vous souhaitez envoyer la rooming list. (L'hôtel recevra en pièce jointe les données contenues dans l'onglet général sans le PNR ni la remarque sur le règlement.)", "Adresse email")
If EmailAddress = "" Then MsgBox "Vous devez préciser un email pour l'envoi. Action interrompue!", vbOKOnly, "Entrée invalide": Exit Sub
If InStr(EmailAddress, "@") = 0 Then MsgBox "Adresse email invalide. Action interrompue!", vbOKOnly, "Adresse invalide": Exit Sub
If MsgBox("Etes-vous certain(e) de vouloir envoyer cette rooming list à l'email suivant : " & EmailAddress & " ?", _
vbQuestion + vbYesNo, _
"Verification avant envoi") = vbNo Then Exit Sub
ActiveSheet.Unprotect "obrat"
Range("J:J, L:L").EntireColumn.Hidden = True
'COPIER DERNIERE LIGNE APRES LIGNE 17
Set Source = Range("A1:S" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
If Source Is Nothing Then MsgBox "La plage n'est pas définie !": Exit Sub
TempFilePath = Environ$("temp") & "\"
'TempFileName = ActiveWorkbook.Name
TempFileName = Range("B1") & " " & Range("C1")
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy Dest.Sheets(1).Cells(1, 1)
Application.CutCopyMode = False
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2016
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
OutMail.SentOnBehalfOfName = "me@myemail.com"
With OutMail
.To = EmailAddress
.CC = ""
.BCC = ""
.Subject = Range("B1") & " " & Range("C1")
.Body = "Hey!" & Chr(10) & Chr(10) & "Please find in attachment the rooming list." & _
Chr(10) & Chr(10) & _
"Best regards," & _
Chr(10) & Chr(10) & _
Application.UserName & " - Tours"
.Attachments.Add Dest.FullName
.Send
End With
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Range("J:J, L:L").EntireColumn.Hidden = False
ActiveSheet.Protect "obrat", True, True
Set OutMail = Nothing
Set OutApp = Nothing
End SubPeut être un Pas à Pas pour connaitre les valeurs de chaque variable pour voir si elles reflètent bien la réalité !
j'ai utilisé ta macro corrigée mais elle ne fonctionne pas avec moi
Elle a aussi changé quelque chose et mon fichier en pièce jointe a perdu la largeur des cellules d'origine..
Ni avec Send ni avec Display la macro ne fonctionne avec un email destinataire autre que l'une des adresses mail associées à Outlook.
Avec Send- rien n'est envoyé..
Avec Display - le mail est généré avec l'adresse email du destinataire (par exemple une adresse Gmail) mais lorsque je l'envoie manuellement, il "disparait" = rien dans la boite courrier sortant ...
je joins de nouveau le fichier...
Elle a aussi changé quelque chose et mon fichier en pièce jointe a perdu la largeur des cellules d'origine..
oui, je l'ai simplifié pour les tests !
je viens de tester ton code tel quel avec ton fichier sans rien changer mis à part ôter l'apostrophe devant OutMail.SentOnBehalfOfName = "me@myemail.com" pour voir et ça fonctionne parfaitement, le problème est ailleurs et à mon avis dans Outlook (autorisations ou autres...)
je suis completement perdu!
Aujourd'hui ca fonctionne...
je met donc ceci en resolu
merci a tous pour votre aide et patience!