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!

 

[daverunt]

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

 

[giuvilas]

Thank you very much daverunt! you made my day!

i will apply my modification. i did some try and everything is working fine right now

in case of any doubt i'll come back to you..but for now it's PERFECT!

thanks again!

 

[daverunt]

Thanks for responding. Glad it's working.

 

[amit17081993]

Hi All,

Actually i am also using the same coding but it will not work for me.

i am getting different names of excel fileson daily basis so i need to send this files to revelant team for action.

please help me in this case.

 

[Michael M]

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

 

[amit17081993]

Dear Micheal,

Actually i m sending different files to different people with different subject.

you can help me in this.

 

[Michael M]

Sounds like a completely new question than the one posted by giuvilas.....
I'd suggest you start a new thread and give us more detail on what you actually want !!

 

[giuvilas]

Hello Guys,

with the business changing i would need to apply some modification to the macro.

I cannot figure out how to add in the subject different text available in different cells. I've been trying for a while but without success the below string

MailSubject = Cells(1, 1).Offset(0, 1).Value & " - " & "Cells(LastRow, 1).Offset(0, 6).Value"

But as a result i get "Customer name - Cells(LastRow, 1).Offset(0, 6).Value" where instead of "Cells(LastRow, 1).Offset(0, 6).Value" i want the value i have in that cell!

any hint? i'm pretty sure it's easy but i cannot find out the way

thanks in advance, appreciated your support as always

 

[giuvilas]

Hello Guys,

with the business changing i would need to apply some modification to the macro.

I cannot figure out how to add in the subject different text available in different cells. I've been trying for a while but without success the below string

MailSubject = Cells(1, 1).Offset(0, 1).Value & " - " & "Cells(LastRow, 1).Offset(0, 6).Value"

But as a result i get "Customer name - Cells(LastRow, 1).Offset(0, 6).Value" where instead of "Cells(LastRow, 1).Offset(0, 6).Value" i want the value i have in that cell!

any hint? i'm pretty sure it's easy but i cannot find out the way

thanks in advance, appreciated your support as always

EDIT: I solved! finally! i hope to not bother you guys for other silly questions