Heres your macro :
Public Sub emailme()
Dim noSession As Object, noDatabase As Object, noDocument As Object
Dim vaRecipient As Variant
Dim rnbody As Range
Dim rnbody1 As Range
Dim Data As DataObject
Const stSubject As String = "P.O. Issues" ****
Const stMsg As String = "Do you have an update on the following:"****
Const stPrompt As String = "Please select the range:"****
vaRecipient = VBA.Array("your email address.com")****A MUST****
On Error Resume Next
Set rnbody = Application.InputBox("Please choose the range", Type:=8)
On Error GoTo 0
If rnbody Is Nothing _
Then MsgBox "RNG is nothing" _
Else 'MsgBox rnbody.Address
rnbody.Select
Set rnbody1 = Range(rnbody, rnbody.Offset(0, 3))************
rnbody1.Select
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
Set noDocument = noDatabase.CreateDocument
rnbody1.Copy
Set Data = New DataObject
Data.GetFromClipboard
With noDocument
.Form = "Memo"
.SendTo = vaRecipient
.Subject = stSubject
.body = stMsg & vbCrLf & vbCrLf & Data.GetText
.SaveMessageOnSend = True
End With
With noDocument
.PostedDate = Now()
.Send 0, vaRecipient
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
'Activate Excel for the user.
AppActivate "Microsoft Excel"
Application.CutCopyMode = False
MsgBox "The e-mail has successfully been created and distributed.", vbInformation
End With
End Sub
Replace the ***** parts with your particular details.
You may need to change the following line :
Set rnbody1 = Range(rnbody, rnbody.Offset(0, 3))************
This by default will use the first cell plus the 3 cells to the right.
I then applied that to a button, but another way I found was to put the following code in your worksheet {copy code,right click sheet tab name, select view code, & paste}
Any cell with the words 'Send Me' in can then be double clicked to invoke the macro.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
Select Case Target.Column
Case 1
If ActiveCell.Value = "Send Me" Then
ActiveCell.Offset(1, 0).Select
Call emailme
End If
End Sub
One gotcha I found was my installation of Excel didn't have the DataObject available.
From the Visual Basic editor, Tools, References.
NB// If References is greyed out then Run, Reset and try again.
- Enable MS Forms 2.0
No comments:
Post a Comment