VBA to send an Outlook email from Excel - Error Troubleshooting

[dwcjmilo]

Hey Everyone,

I'm building a template in Excel that will send an email when they click on a designated email button. The code I'm using now that gets me close to the end result I'm looking for is here:

Sub SendIt()
ActiveWorkbook.SendMail
("myemailaddress@mycompany.com"), Subject:=ActiveSheet.Range("K10:L10")
End Sub

When I click on the button, I get a Microsoft Outlook prompt that says "A program is trying to send an email message on your behalf. If this is unexpected, click Deny and verify your antivirus software is up-to-date." ... "For more information about email safety and how you might be able to avoid getting this warning, click Help."

Once this comes up, I click "Allow" and the same message pops up again. If I click allow a second time, I get two emails. if I "Deny" the 2nd or close out of it, then I just get the one I wanted.

To further complicate my request, I get a Microsoft Visual Basic error that says: "Run-time error '1004': General Mail failure. Quit Microsoft Excel, restart the mail system, and try again." with an End and Debug option to select.

So my question would be this:
- I'm looking for a VBA code that will send an email without a worksheet attachment or anything in the body of the email.
- I'm also hoping that whatever option is available will bypass the errors my IT team couldn't quickly figure out as this was a low priority request for them.

For reference, I'm using Office 2013 products.

Thank you for any guidance I can get.

 

[CalcSux78]

Check out Ron deBruin's info on emailing: https://www.rondebruin.nl/win/s1/outlook/mail.htm

Modified from his "Mail Small Message" page, example 1:

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    strbody = ""        'OP requested blank email body


    On Error Resume Next
    With OutMail
        .To = "myemailaddress@mycompany.com"
        .CC = ""
        .BCC = ""
        .Subject = ActiveSheet.Range("K10:L10")
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[dwcjmilo]

Awesome! One step closer, but still missing the Subject Line in the emails. I just tried tinkering with the code you provided but don't understand why the subject in the email is still blank when the active range is being specified. Any ideas?

Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = ""
On Error Resume Next
With OutMail
.To = "myemailaddress@mycompany.com"
.CC = ""
.BCC = ""
.Subject = ActiveSheet.Range("K10:L10")
.Body = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[shg]

You can't send a range as a subject. You would need to write a loop to catenate those values, or whatever else you want to do.

 

[dwcjmilo]

I was able to successfully send a range (Since it was 2 merged cells that had a concatenate formula to customize the subject content) with the code in my original post but had some unrelated issues with it.. The 2nd code that was provided works much better to bypass my original issues but omits the Subject line. I just can't seem to find the right combo of merging those two scripts.

 

[shg]

You could use a formula to catenate the values of those cells, and use that (single-cell value) as the subject.

 

[CalcSux78]

Sub Mail_small_Text_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
[COLOR=#ff0000]Dim cel As Range[/COLOR]
[COLOR=#ff0000]Dim strSubj As String[/COLOR]
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


[COLOR=#ff0000]For Each cel In ActiveSheet.Range("K10:L10").Cells[/COLOR]
[COLOR=#ff0000]    strSubj = strSubj & cel.Value[/COLOR]
[COLOR=#ff0000]Next cel[/COLOR]


strbody = ""
On Error Resume Next
With OutMail
    .To = "myemailaddress@mycompany.com"
    .CC = ""
    .BCC = ""
    .Subject = [COLOR=#ff0000]strSubj[/COLOR]
    .Body = strbody
    .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[dwcjmilo]

Calcsux78!!! I just cheered in my office like I would at a ball game and now everyone is staring at me like I've lost my mind! lol... Thank you Sir!

 

[CalcSux78]

Glad we could help.. And thank you shg! Forgot about the range thing.