Updated May 6 2010 – added Call varXLFile.Quit()
I’ve been looking for ways to recognize people’s voluntary contributions to community discussions. E-mailed thanks are great because people can use the Memo-to-File feature to save it in their performance record, and copying their managers means extra kudos.
I wanted to thank 21 people for their contributions. With the Lotus Connections Communities API, a little bit of Ruby scripting and an internal tool for looking up people’s managers, I came up with a spreadsheet that listed people’s names, e-mail addresses, number of posts, first-line manager, and either “post” or “posts” depending on how many posts they had. Pulling random bits together from examples on the Net, I developed this super-nifty Lotus Notes script which does a flexible mail merge from a Microsoft Excel spreadsheet to Lotus Notes.
Create the agent and copy the following code into it. Then write an e-mail that you’ll use as the template for your new messages, and call the agent while the e-mail is selected. Give it a spreadsheet where the column headings are the tokens you’d like to replace in the template (body only). “<to>” and “<cc>” are special – they’ll also be replaced in the mail header. The resulting mail messages will be in the “Drafts” folder so that you can customize the messages before sending them out.
This may not work with multi-line replacements or fancy formatting. Review before sending, and have fun. =)
Sub Initialize Dim ws As New NotesUIWorkspace 'Prompt for the filename - should be a Microsoft Excel file 'with columns, where the first row of each column 'is a token that will be used when replacing text in the body of the message 'Special tokens: <to> and <cc> set the appropriate fields fileName$ = ws.Prompt(12, "Select file", "3") If fileName$ = "" Then Exit Sub 'Cancel was presed End If strXLFilename = fileName$ Dim s As New NotesSession Dim uidoc As NotesUIDocument Dim partno As String Dim db As NotesDatabase Dim view As NotesView Dim doc As NotesDocument Dim collection As NotesDocumentCollection Dim memo As NotesDocument Dim body As NotesRichTextItem Dim newBody As NotesRichTextItem Dim range As NotesRichTextRange Dim count As Integer Set db = s.CurrentDatabase Set collection = db.UnprocessedDocuments Set memo = collection.getFirstDocument() 'Get data from the spreadsheet Set varXLFile = CreateObject("Excel.Application") varXLFile.Visible = False Set varXLWorkbook = Nothing varXLFile.Workbooks.Open strXLFilename Set varXLWorkbook = varXLFile.ActiveWorkbook Set varXLSheet = varXLWorkbook.ActiveSheet lngRow = 2 While (Not (varXLSheet.Cells(lngRow, 1).Value = "")) 'Fill in the template subject = memo.Subject(0) Set body = memo.GetFirstItem("Body") 'Compose message Set maildoc = New NotesDocument(db) Set maildoc= db.CreateDocument() maildoc.Form = "Memo" maildoc.Subject = subject Set newBody = maildoc.CreateRichTextItem("Body") Call newBody.appendRTItem(body) Set range = newBody.CreateRange 'Look up tokens from the column headings and replace them columnNo = 1 While Not(varXLSheet.Cells(1, columnNo).Value = "") token = varXLSheet.Cells(1, columnNo).Value value = varXLSheet.Cells(lngRow, columnNo).Value count = range.FindAndReplace(token, value, 16) If (token = "<to>") Then maildoc.SendTo = value End If If (token = "<cc>") Then maildoc.CopyTo = value End If columnNo = columnNo + 1 Wend Call maildoc.Save(True, False) lngRow = lngRow +1 Wend Call varXLFile.Quit() End SubShort URL: http://sachachua.com/blog/p/6468