vba sendemail macro is not working with .send (but working manually with .display)

[emwaj]

Hey to all.

I have a macro which should work but it doesn't when I change .Display to .Send

With .display: the email is generated exactly as I want, and if I click manually in Outlook on SEND the email is correctly sent to destination address.

BUT, so weird, when I try to execute the macro automatically with .Send, nothing happens. And also there is no error message in the macro.

I really don't understand what is the problem!

Hope someone will be able to help me...


Here is the 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 JUSQU'A DERNIERE LIGNE APRES LIGNE 18


LastRow = WorksheetFunction.Max(18, Range("B" & Rows.Count).End(xlUp).Row)
Set Source = Range("A1:T" & 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 = 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 = "groups@obratours.co.il"


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


.Close savechanges:=False
End With


'WRITE TIME
[W10] = Date
[W9] = EmailAddress
[W11] = Time


Kill TempFilePath & TempFileName & FileExtStr


CreateObject("WScript.Shell").Popup "Cette rooming list vient d'être envoyée à l'email suivant:" & " " & EmailAddress & " " & ".", 2, "Confirmation d'envoi"


Set OutMail = Nothing
Set OutApp = Nothing


Columns("J").EntireColumn.Hidden = False
Columns("L").EntireColumn.Hidden = False




'WRITE TIME
[W10] = Date
[W9] = EmailAddress
[W11] = Time


ActiveSheet.Range("a3").Activate


ActiveSheet.Protect "obrat", True, True
ActiveWorkbook.Save


With Application
.ScreenUpdating = True
.EnableEvents = True
End With




   
End Sub

 

[Logit]

.
I've experienced the same problem here ... from time to time. My solution was to open Outlook first, running in the back ground.
Then run the email macro.

If that works for you, you may need to add code at the top of your macro that runs Outlook.exe first.

 

[emwaj]

I have closed now Outlook application and have opened it again, and then I have tried to execute the macro, but still nothing with .Send (only with .display it works...)

 

[emwaj]

I need to note here that the macro works with .Send only if the destination address is inside the society.
We have a few email accounts, all of the addresses are with the same organization name (XX@MYSOCIETY.CO.XX)
So if I send the email through the macro it works even if if with .send option.

But if try to send to a regular email outside my society, it doesn't work!

 

[Logit]

.
If by "society" you mean the network in a company your are working for, perhaps the IT Director has some form of 'block' ?

Or do you mean something different by "society" ?

 

[emwaj]

.
If by "society" you mean the network in a company your are working for, perhaps the IT Director has some form of 'block' ?

Or do you mean something different by "society" ?

I don't think something is blocked because Outlook manages sending emails to everyone, but I don't know where is the problem.
Nevermind.
I will only use .Display function.

Thanks anyway!

 

[thunderin]

I had the exact same problem. I received runtime error -2147024809 with description:
"Sorry, something went wrong. You may want to try again."

I didn't try the suggested workaround explained above about Outlook but when I avoided disabling the .Display line (the email was shown), and then I also had .Send executed afterwards, the email was sent out without any run-time error. When I tried only .Send without the .Display, it yielded the aforementioned runtime error.

My macro is using the Word editor to customize the body of the email in Outlook (through .GetInspector.WordEditor) so maybe this is somehow related to the runtime error.