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

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Code:
[COLOR=#333333]Private Sub CommandButton2_Click()[/COLOR]
Call SendEmail
[COLOR=#333333]End Sub[/COLOR]
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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
Back
Top