Create a Action Button and copy paste following Lotus Script.
When you click on action button it will open excel file.. add following columns and once your are done click "OK" Prompt button...
This is select individual rows and send mail.
Columns 1: To
Columns 2: Subject
Columns 3: Body Content
Programming Code:
Sub Click(Source As Button)
on error goto ErrorHandling
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim richStyle As NotesRichTextStyle
Dim color As NotesColorObject
Dim xlApp As Variant
Dim xlsheet As Variant
Dim ARangeValue As Variant
Dim I As Integer
Dim c As Integer
Dim j As Integer
Dim answer As Integer
Set db = session.CurrentDatabase
Set doc = New NotesDocument( db )
Set richStyle = session.CreateRichTextStyle
Set color = session.CreateColorObject
color.NotesColor = 240
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
xlApp.Workbooks.add
Set xlsheet = xlApp.Workbooks(1).Worksheets(1)
xlsheet.Activate
Messagebox " Copy the data in the excelsheet, Once you click 'OK' mail will sent to the respected users."
c=65
While Not xlsheet.Range(Chr(c) & "1").Value = ""
i=2
doc.Form = "Memo"
doc.SendTo = xlsheet.Range("A" & Trim(Str(i + 1))).Value
doc.Subject = xlsheet.Range("B" & Trim(Str(i + 1))).Value
Dim richText As New NotesRichTextItem(doc, "Body")
Call richText.AddNewline(1)
richStyle.Bold = True
richStyle.NotesColor = COLOR_BLUE
richStyle.FontSize = 18
Call richText.AppendStyle(richStyle)
Call richText.AppendText("Title with Tex Style")
richStyle.Bold = False
richStyle.FontSize = 10
richStyle.NotesColor = COLOR_BLACK
Call richText.AppendStyle(richStyle)
Call richText.AddNewline(2)
Call richText.AppendText("Body Contents for the mail....")
Call doc.Save(True, False)
Call doc.Send( False )
i = i + 1
Wend
Messagebox "Auto Mail send Process is Complited"
Exit Sub
ErrorHandling:
Messagebox Error
End Sub
Great Code! I've used this technique successfully until I installed Office 2013. Now the first worksheet is created successfully but as I create additional worksheets I receive an OLE error. Have you experienced this with Excel 2013? Here is my code to create Worksheet 2.
ReplyDeleteSet xlsheet = xlApp.Workbooks(1).Worksheets(2) 'select second worksheet for summations
'worksheet title
xlsheet.Columns("C:C").Style = "Currency"
xlsheet.Name = "Summary"
xlApp.Rows("1:1").Select
xlsheet.Columns("A:A").ColumnWidth = 50
xlsheet.Columns("B:B").ColumnWidth = 5
xlsheet.Columns("C:C").ColumnWidth = 14
rows = 1