Updated May 6 2010 – added Call varXLFile.Quit()

Mwahahahahaha!

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 Sub