Search This Blog

Monday 6 June 2011

Sending IBM/Lotus Domino eMails from Excel


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