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
 

Some videos you may like

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

mick0005

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

Watch MrExcel Video

Forum statistics

Threads
1,123,329
Messages
5,600,994
Members
414,418
Latest member
mightyMagnus

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