Macro - Send an email through Outlook

[giuvilas]

Hi Everyone,

i'm new here i made a research on internet and this is what is mentioned to be the best Excel forum available.
So here I am asking for an advise from some experienced user.

So let's meet the point of this thread..

I need to create a Macro (I'm using Office 2010 Professional + Windows 7 Professional 64bit) in order to send an email (using my Outlook 2010) using all the time the data available on the LAST row of my spreadsheet (of course it's variable, since I'm updating the file on daily basis).

Now, in this row i have the following string that i need to include into the email:

- protocol #
- reference #
- email address

[/URL][/IMG]

The email i want to create it has to be like this:

Mailto: "xyz3@xyz.com"
Subject: "900 - Notification of rejection"

Body of the email:

"Dear customer,

your document "456" has been rejected because blabla..

regards"

I don't want that the macro send automatically the email, since i have to enclose an attachment (i prefer attach the document manually for some reason).

Furthermore i would like to create a rule, that when i'm running the macro is giving me the possibility to chose two (or more) different templates (different subject and body)

I tried the following code modifying the following string in order to take in consideration just the last row:
"Dim r As Integer, x As Double
For r = 2 To 4"

But it didn't work out. I had a pop-up window saying something about shellexecute not found (maybe because i'm using 64bit OS?)

Please help me. It will be really appreciated ..possibly if can share some new code..

The following code is what i tried (with some small modification..

Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _ByVal nShowCmd As Long) As Long
Sub SendEMail() Dim Email As String, Subj As String Dim Msg As String, URL As String Dim r As Integer, x As Double For r = 2 To 4 'data in rows 2-4' Get the email address Email = Cells(r, 2) ' Message subject Subj = "Your Annual Bonus"' Compose the message Msg = "" Msg = Msg & "Dear " & Cells(r, 1) & "," & vbCrLf & vbCrLf Msg = Msg & "I am pleased to inform you that your annual bonus is " Msg = Msg & Cells(r, 3).Text & "." & vbCrLf & vbCrLf Msg = Msg & "William Rose" & vbCrLf Msg = Msg & "President" ' Replace spaces with %20 (hex) Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20") Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20") ' Replace carriage returns with %0D%0A (hex) Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
' Create the URL URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg ' Execute the URL (start the email client) ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus' Wait two seconds before sending keystrokes Application.Wait (Now + TimeValue("0:00:02")) Application.SendKeys "%s" Next rEnd Sub
Thank you to everyone for the eventual help!

 

[EPURON]

Thanks, Might come in handy for myself

 

[Erestes]

If you want to add extra files to the e_mail, try

Sub Mail_Outlook()
Dim OutApp As Object
Dim OutMail As Object

 LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
 
 If Cells(LastRow, 1).Value <> "" Then
 
 MailTo = Cells(LastRow, 1).Offset(0, 2).Value
       
 Template = InputBox("Enter the template number to use.", Title:="Enter the Template number")
       
       
 Select Case Template
 
 Case Is = 1
    MailSubject = Cells(LastRow, 1).Offset(0, 1).Value & " - Notification of rejection"
    MailBody = "Dear customer," & vbNewLine & vbNewLine & _
    "your document " & Cells(LastRow, 1).Value & " has been rejected because blabla.." & _
    vbNewLine & vbNewLine & "Regards," & vbNewLine & vbNewLine & "Sender Name"
 
 Case Is = 2
    MailSubject = "You selected 2"
    MailBody = "Mail Body 2"
 Case Is = 3
    MailSubject = "You selected 3"
    MailBody = "Mail Body 3"
 Case Else
    MailSubject = "What!"
    MailBody = "What!"
 End Select
 ans = MsgBox("Will you need to add further attachments ??", vbYesNo)
        If ans = vbYes Then
            AttachFileName = Application.GetOpenFilename("Files (*.**)," & _
                                "*.**", 1, "Select File", "Open", True)
        End If
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = MailSubject
            .To = MailTo
            .body = MailBody
                For a = 1 To UBound(AttachFileName)
                    .Attachments.Add AttachFileName(a)
                Next
            .Display
            '.Send
        End With
        
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
   
End Sub

Michael,
I have found your addition of the external file very usefull, but I have a little problem with it. It works perfectly fine if I select "yes" and attach a file but if shows an Type missmatch error when I click "No" -> This seem to be causing the problem: For a = 1 To UBound(AttachFileName).

Any idea how to fix this?

 

[daverunt]

Hi,

This should work for you: It skips the For loop if the AttachFileName is empty

.body = MailBody
            If Not IsEmpty(AttachFileName) Then
                For a = 1 To UBound(AttachFileName)
                    .Attachments.Add AttachFileName(a)
                Next
               End If
            .Display

 

[ankit007bhatnagar]

Hi

Can't help with the code you have posted - too difficult for me.

Is there any reason you can't use the following method.
If you do you will need to select the Microsoft Outlook xx.x Object Model from the Excel VBA editor Tools/References


You can find a lot of mail sending info here too.
Example Code for sending mail from Excel

Sub Mail_Outlook()
Dim OutApp As Object
Dim OutMail As Object

 LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
 
 If Cells(LastRow, 1).Value <> "" Then
 
 MailTo = Cells(LastRow, 1).Offset(0, 2).Value
       
 Template = InputBox("Enter the template number to use.", Title:="Enter the Template number")
       
       
 Select Case Template
 
 Case Is = 1
    MailSubject = Cells(LastRow, 1).Offset(0, 1).Value & " - Notification of rejection"
    MailBody = "Dear customer," & vbNewLine & vbNewLine & _
    "your document " & Cells(LastRow, 1).Value & " has been rejected because blabla.." & _
    vbNewLine & vbNewLine & "Regards," & vbNewLine & vbNewLine & "Sender Name"
 
 Case Is = 2
    MailSubject = "You selected 2"
    MailBody = "Mail Body 2"
 Case Is = 3
    MailSubject = "You selected 3"
    MailBody = "Mail Body 3"
 Case Else
    MailSubject = "What!"
    MailBody = "What!"
 End Select
 
 
'Send Mail
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(o)
        With OutMail
            .Subject = MailSubject
            .To = MailTo
            .body = MailBody
            '.Attachments.Add FileNme
            .Display
            '.Send
        End With
        
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
   
End Sub

Hi ,
The above mentioned coding is not working fine may be i m not using it correctly or at the right place.

 

[merlin777]

I need to just send a simple email messag from excel. I've looked at all the code examples but they all do more than i need and i'm having trouble deleting the right bits.

I want to send an email from excel by clicking on a button. 4 cells will contain:

to: address
cc: address
tile
body text

Please could someone help me with code for just the basic sending of an email?

tia

 

[merlin777]

I need to just send a simple email messag from excel. I've looked at all the code examples but they all do more than i need and i'm having trouble deleting the right bits.

I want to send an email from excel by clicking on a button. 4 cells will contain:

to: address
cc: address
tile
body text

Please could someone help me with code for just the basic sending of an email?

tia

i've sort of worked it out:

Sub sendemail()    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object


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


        
        With OutMail
            .to = Worksheets("admin").Range("f9")
            .CC = Worksheets("admin").Range("f10")
            .BCC = ""
            .Subject = Worksheets("admin").Range("f11")
            .Body = Worksheets("admin").Range("f12")
                       
            .display
        End With
    


   
End Sub

The first few times i ran it i got a runtime error but then it ran ok - i didn't make any changes so i don't know why?

 

[Michael M]

It's generally better to add .value to your cell references !!

With OutMail
            .to = Worksheets("admin").Range("f9").value
            .CC = Worksheets("admin").Range("f10").value
            .BCC = ""
            .Subject = Worksheets("admin").Range("f11").value
            .Body = Worksheets("admin").Range("f12").value
                       
            .display
        End With

 

[merlin777]

thanks, michael.

what's the danger if you don't?

 

[Michael M]

I believe it's simply good practice, but a further comment by others is...
Using .Value is also useful to "dis-ambiguate" the common "forgot to use Set when assigning an object variable" problem -
Dim a
Set a = Range("A1")
vs
Dim a
a = Range("A1")

In the second case always using .Value clarifies the actual problem

 

[merlin777]

thanks for that