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