EXCEL / VBA Help - Sending Emails from a excel spreadsheet using click of a button

rocstu9006

New Member
Joined
Jun 12, 2015
Messages
1
Hi, I'm completely new to attempting anything in VBA but am trying to work out a few things to make life easier at work. Getting there but keep getting stuck.

I have a code in VBA for sending emails with details from a worksheet. I now want it to send from a click of a button on the excel spreadsheet rather than going to 'run macro'. I've inserted the to button but I am unsure how the code should be with the buttons automatic code of:

Private Sub CommandButton2_Click()

End Sub

How do I combine the two codes? I tried many things and just get compile areas. Not sure what I am missing here.

Any help with this would be much appreciated, thanks!

My current code which is not linked to the button but works with run macro command, looks like this:

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
Email = Cells(ActiveCell.Row, 16)

Subj = Cells(ActiveCell.Row, 1) & vbCrLf & vbCrLf & "Reminder: Reports due this month"

Msg = ""
Msg = Msg & Cells(ActiveCell.Row, 1) & "," & vbCrLf & vbCrLf & "Reminder: This project has Progress Reports due this month. " & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 12) & vbCrLf & vbCrLf & "Reminder: This project has financial reports due this month. " & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 13) & vbCrLf & vbCrLf & "Reminder: This project will require an Audit this month. " & vbCrLf & vbCrLf & Cells(ActiveCell.Row, 14)

'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"

End Sub
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

mick0005

Active Member
Joined
Feb 21, 2011
Messages
406
Code:
[COLOR=#333333]Private Sub CommandButton2_Click()[/COLOR]
Call SendEmail
[COLOR=#333333]End Sub[/COLOR]
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,373
Messages
5,836,875
Members
430,460
Latest member
cristian270

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top