none
Send email from Word vba to Lotus Notes using multiple recipients. RRS feed

  • Question

  • I have Word Template that allows users to select certain criteria and then save document to a predetermined path and file name cancatanated from selections made on template. This all works fine except my company uses Lotus Notes for e-mail. I collected enough code ideas from Googling and get all to work except I can not figre out how to send to multiple recipients. I have separate e-mail routing lists in Excel saved as TXT and CSV formatted files and can read this data into a variable but when I assign that variable to the send command, I only get first name activated. No other names get e-mail sent. I've tried variable as variant, tried variable as string, tried variable as an array. Just can't seem to get it to work.

    Please note that I am a novice and do not work in nay programming career. I do this jusst to help out people and bring some continuity and uniformity to reports that get sent on each 12 hour shift. I want the email address datbase to be a simple Excel workbook that anyone can easily update.

    Thanks in advance,

    Glenn

    Wednesday, May 30, 2012 3:36 AM

Answers

  • Hi Chevyman,

    The variable vEmails should be deleted. Sorry.

    Since the variable OssRecipList has been declared as a global variable, and it is used for the recipients, call "SendToNotesNow" directly in the GetRecipList sub. 

    "The other variables also show errors and are not being populated by any values." 

    I assume that you didn't add the Excel library first. 

    Tools-> References-> Check "Microsoft Excel 14.0 Object library".

    I have edited my last response based on the foregoing statements. You can refer to it.

    Thanks.

    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us

    • Marked as answer by Chevyman57 Tuesday, June 5, 2012 11:11 PM
    Tuesday, June 5, 2012 3:19 AM
    Moderator

All replies

  • Hi Glenn,

    Please refer to the following link. It provides VBA code on how to send email via Lotus Notes.

    Lotus Notes Send EMail from VB or VBA
    http://www.fabalou.com/VBandVBA/lotusnotesmail.asp 

    'Public Sub SendNotesMail(Subject as string, attachment as string,
    'recipient as string, bodytext as string,saveit as Boolean)
    'This public sub will send a mail and attachment if neccessary to the
    'recipient including the body text.
    'Requires that notes client is installed on the system.
    Public Sub SendNotesMail(Subject As String, Attachment As String, Recipient As String, BodyText As String, SaveIt As Boolean)
    'Set up the objects required for Automation into lotus notes
        Dim Maildb As Object 'The mail database
        Dim UserName As String 'The current users notes name
        Dim MailDbName As String 'THe current users notes mail database name
        Dim MailDoc As Object 'The mail document itself
        Dim AttachME As Object 'The attachment richtextfile object
        Dim Session As Object 'The notes session
        Dim EmbedObj As Object 'The embedded object (Attachment)
        'Start a session to notes
        Set Session = CreateObject("Notes.NotesSession")
        'Next line only works with 5.x and above. Replace password with your password
        Session.Initialize("password")
        'Get the sessions username and then calculate the mail file name
        'You may or may not need this as for MailDBname with some systems you
        'can pass an empty string or using above password you can use other mailboxes.
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        'Open the mail database in notes
        Set Maildb = Session.GETDATABASE("", MailDbName)
         If Maildb.ISOPEN = True Then
              'Already open for mail
         Else
             Maildb.OPENMAIL
         End If
        'Set up the new mail document
        Set MailDoc = Maildb.CREATEDOCUMENT
        MailDoc.Form = "Memo"
        MailDoc.sendto = Recipient
        MailDoc.Subject = Subject
        MailDoc.Body = BodyText
        MailDoc.SAVEMESSAGEONSEND = SaveIt
        'Set up the embedded object and attachment and attach it
        If Attachment <> "" Then
            Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
            Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
            MailDoc.CREATERICHTEXTITEM ("Attachment")
        End If
        'Send the document
        MailDoc.PostedDate=Now() 'Gets the mail to appear in the sent items folder
        MailDoc.SEND 0, Recipient
        'Clean Up
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set AttachME = Nothing
        Set Session = Nothing
        Set EmbedObj = Nothing
    End Sub

    Also for multiple email addresses you just set MailDoc.sendto to an array of variants each of which will receive the message. So

    Dim recip(25) as variant
    recip(0) = "emailaddress1"
    recip(1) = "emailaddress2" e.t.c

    maildoc.sendto = recip

    Meanwhile, for Lotus Notes questions, please contact this IBM site as well:

    http://www-01.ibm.com/software/lotus/products/notes/

    Thanks.

    This response contains a reference to a third party World Wide Web site. Microsoft is providing this information as a convenience to you. Microsoft does not control these sites and has not tested any software or information found on these sites; therefore, Microsoft cannot make any representations regarding the quality, safety, or suitability of any software or information found there. There are inherent dangers in the use of any software found on the Internet, and Microsoft cautions you to make sure that you completely understand the risk before retrieving any software from the Internet.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us

    Friday, June 1, 2012 6:14 AM
    Moderator
  • YoYo,

    The code above is the same code I am currently using and it works fine. My issue is that I need "recipient" variable to contain a "list" or "array" of e-mail address that is set from code reading an Excel file of e-mail addresses. See my code below to set the "recipient" variable. After this code runs and I send the e-mail, it only sends to first recipient in my list, not all of them. I have tried various declarations for "recipient" and "OssRecipList" with no success.

    Thanks, Glenn

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Dim OssRecipList as Variant

    Sub GetRecipList()
    OssRecipList = GetFileContent("C:\ossreciplist.xls")
        MsgBox OssRecipList
        SendToNotesNow
    End Sub
    Function GetFileContent(Name As String) As String
        Dim intUnit As Integer
        On Error GoTo ErrGetFileContent
        intUnit = FreeFile
        Open Name For Input As intUnit
        GetFileContent = Input(LOF(intUnit), intUnit)
    ErrGetFileContent:
        Close intUnit
        Exit Function
    End Function

    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    Sub SendToNotesNow()
    Dim UserName As String
    Dim MailDbName As String
    Dim Recipient As Variant
    Dim Attachment1 As String
    Dim Maildb As Object
    Dim MailDoc As Object
    Dim AttachME As Object
    Dim EmbedObj1 As Object
    Dim Session As Object
    Dim stSignature As String
    On Error Resume Next
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    Set Session = CreateObject("Notes.NotesSession")
        UserName = Session.UserName
        MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    Set Maildb = Session.GetDatabase("", MailDbName)
            If Maildb.IsOpen = True Then
                Else
                    Maildb.OPENMAIL
            End If
    Set MailDoc = Maildb.CREATEDOCUMENT
    stSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
        MailDoc.Form = "Memo"
        MailDoc.Recipient = OssRecipList
        MailDoc.SendTo = Recipient
        MailDoc.Subject = FinalFileName
        MailDoc.Body = stSignature
        MailDoc.SaveMessageOnSend = True
        MailDoc.attachment = Attachment1
        Attachment1 = FinalFileNameWithExt
            If Attachment1 <> "" Then
                On Error Resume Next
                    Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment")
                    Set EmbedObj1 = AttachME.embedobject(1454, FinalFileNameWithExt, "")
                        On Error Resume Next
            End If
        MailDoc.PostedDate = Now()
       
    On Error GoTo eMailError
    MailDoc.SEND 0, Recipient
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj1 = Nothing
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    eMailError:
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj1 = Nothing
    End Sub

    Friday, June 1, 2012 10:54 AM
  • Hi Chevyman,

    Thanks for your response.

    To get data from an excel worksheet, you may try the following code:

    Dim OssRecipList as Variant
    Sub GetRecipList() OssRecipList = OpenExcelFile("E:\Test\TestEmails.xls")

      SendToNotesNow End Sub

    Function OpenExcelFile(Name As String) As Variant
    Dim oApp As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oWorksheet As Excel.Worksheet

    Set oWB = Workbooks.Open(Name)
    Set oWorksheet = oWB.Sheets(1)
    OpenExcelFile = oWorksheet.UsedRange
    oWB.Close
    End Function

    Or you can convert the excel worksheet to a text file, and try the following code:

    Dim OssRecipList as Variant
    Sub GetRecipList() OssRecipList = GetFileContent("E:\Test\TestEmails.txt")
    SendToNotesNow End Sub Function GetFileContent(Name As String) As Variant Dim intUnit As Integer On Error GoTo ErrGetFileContent Dim arrayList() As String intUnit = FreeFile Dim i As Integer i = 1 Open Name For Input As #intUnit Do While Not EOF(intUnit) ReDim arrayList(i - 1) Input #intUnit, arrayList(i - 1) Debug.Print arrayList(i - 1) i = i + 1 Loop GetFileContent = arrayList ErrGetFileContent: Close intUnit Exit Function End Function

    Thanks.


    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us

    Monday, June 4, 2012 6:29 AM
    Moderator
  • Yoyo,

    This code runs OK but I don't see where your assigniing any value to 'vEmails'. That

    variable always shows "Empty" when I run this code.

    I don't know how to use this in my original code as the recipient variable.

    As you probably have guessed, I am not a programmer and only do this as a hobby like to help out. 

    The other variables also show errors and are not being populated by any values.

    Glenn

    Sub GetRecipList()   
        OssRecipList
    = OpenExcelFile("C:\ossreciplist.xls")   
    End Sub

    Function OpenExcelFile(Name As String) As Variant
    Dim oWB As Workbook
    Dim oWorksheet As Worksheet
    Dim vEmails As Variant
    Set oWB = Workbooks.Open(Name)
    Set oWorksheet = oWB.Sheets(1)
    OpenExcelFile
    = oWorksheet.UsedRange
    oWB
    .Close
    End Function

    Monday, June 4, 2012 8:08 PM
  • Hi Chevyman,

    The variable vEmails should be deleted. Sorry.

    Since the variable OssRecipList has been declared as a global variable, and it is used for the recipients, call "SendToNotesNow" directly in the GetRecipList sub. 

    "The other variables also show errors and are not being populated by any values." 

    I assume that you didn't add the Excel library first. 

    Tools-> References-> Check "Microsoft Excel 14.0 Object library".

    I have edited my last response based on the foregoing statements. You can refer to it.

    Thanks.

    Yoyo Jiang[MSFT]
    MSDN Community Support | Feedback to us

    • Marked as answer by Chevyman57 Tuesday, June 5, 2012 11:11 PM
    Tuesday, June 5, 2012 3:19 AM
    Moderator
  • YoYo,

    Got it!

    Here's my final code. Had to add a quit line to get excel to exit out of memory and found that the csv formatted file

    works "cleaner" in Notes "To" field.

    Hope I did it right.

    Thanks,

    Glenn

    Option Explicit

    Dim cBO1 As MSForms.ComboBox
    Dim cBO2 As MSForms.ComboBox
    Dim cBO3 As MSForms.ComboBox
    Dim dCD As String
    Dim dCD1 As String
    Dim dCD2 As String
    Dim dCD3 As String
    Dim dCD4 As String
    Dim dCD5 As String
    Dim dCD6 As String
    Public myDocname As String
    Dim myDocname1 As String
    Dim myDocname2 As String
    Dim myDocname3 As String
    Dim myDocname4 As String
    Dim cBT2 As String
    Dim cPATH1 As String
    Dim cPATH2 As String
    Dim filesys, newfolder
    Public FinalFileName As String
    Public FinalFileNameWithExt
    Public OssRecipList As Variant

    Sub AutoNew()
        Application.DisplayAlerts = wdAlertsAll
        ActiveDocument.ActiveWindow.View.Type = wdPrintView
        ComboBox1.MousePointer = fmMousePointerDefault
        ComboBox1.ShowDropButtonWhen = fmShowDropButtonWhenAlways
        ComboBox2.MousePointer = fmMousePointerDefault
        ComboBox2.ShowDropButtonWhen = fmShowDropButtonWhenAlways
        ComboBox3.MousePointer = fmMousePointerDefault
        ComboBox3.ShowDropButtonWhen = fmShowDropButtonWhenAlways
        ComboBox1.Locked = False
        ComboBox2.Locked = False
        ComboBox3.Locked = False
        ComboBox1.Enabled = True
        ComboBox2.Enabled = True
        ComboBox3.Enabled = True
        ComboBox1.Locked = False
        ComboBox2.Locked = False
        ComboBox3.Locked = False
        ComboBox1.Enabled = True
        ComboBox2.Enabled = True
        ComboBox3.Enabled = True
     Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=7
       FillList1
       FillList2
       FillList3
     cBT2 = "NotSaved"
    End Sub

    Sub AutoOpen()
    ActiveDocument.ActiveWindow.View.Type = wdPrintView
    Selection.GoTo What:=wdGoToLine, Which:=wdGoToAbsolute, Count:=7
    End Sub

    Sub FillList1()
          Set cBO1 = ActiveDocument.ComboBox1
       With cBO1
          .AddItem "Select Supervisor", 0
          .AddItem "person one", 1
          .AddItem "person two", 2
       End With
     Set cBO1 = Nothing
    End Sub

    Sub FillList2()
           Set cBO2 = ActiveDocument.ComboBox2
      With cBO2
          .AddItem "Select Shift", 0
          .AddItem "Plant Wide P", 1
          .AddItem "Plant Wide Q", 2
          .AddItem "Plant Wide R", 3
          .AddItem "Plant Wide S", 4
       End With
     Set cBO2 = Nothing
    End Sub

    Sub FillList3()
           Set cBO3 = ActiveDocument.ComboBox3
       With cBO3
          .AddItem "Moon or Sun", 0
          .AddItem "Days", 1
          .AddItem "Nights", 2
       End With
     Set cBO3 = Nothing
    End Sub

    Private Sub CommandButton1_Click() 'SAVE Function
    Dim Msg, Style, Title, Response
    Dim selectOK1 As Integer
    Dim selectOK2 As Integer
    Dim selectOK3 As Integer
        Msg = "Please Select Supervisor Name!"
        Style = vbOKOnly + vbExclamation
        Title = "Warning! No Supervisor Name"
            If ComboBox1.Value = "Select Supervisor" Then
                Response = MsgBox(Msg, Style, Title)
                ComboBox1.DropDown
    End If
        Msg = "Please Select Current Shift!"
        Style = vbOKOnly + vbExclamation
        Title = "Warning! No Shift Selected"
            If ComboBox2.Value = "Select Shift" Then
                Response = MsgBox(Msg, Style, Title)
                ComboBox2.DropDown
    End If
        Msg = "Please Select Days or Nights!"
        Style = vbOKOnly + vbExclamation
        Title = "Warning! Is The Moon or Sun Shining?"
            If ComboBox3.Value = "Moon or Sun" Then
                Response = MsgBox(Msg, Style, Title)
                ComboBox3.DropDown
    End If
            If ComboBox1.Value <> "Select Supervisor" Then
            If ComboBox2.Value <> "Select Shift" Then
            If ComboBox3.Value <> "Moon or Sun" Then
    Call SaveThisDoc  'SAVE Sub Function
    Else: End
    End If
    End If
    End If
    End Sub

    Sub SaveThisDoc() ' SAVE Sub Function
    chkpath
    cBT2 = "DocSaved"
    Dim Msg, Style, Title, Response
        Set cBO1 = ActiveDocument.ComboBox1
        Set cBO2 = ActiveDocument.ComboBox2
        Set cBO3 = ActiveDocument.ComboBox3
        ComboBox1.Locked = True
        ComboBox2.Locked = True
        ComboBox3.Locked = True
        ComboBox1.Enabled = False
        ComboBox2.Enabled = False
        ComboBox3.Enabled = False
        ComboBox1.ShowDropButtonWhen = fmShowDropButtonWhenNever
        ComboBox2.ShowDropButtonWhen = fmShowDropButtonWhenNever
        ComboBox3.ShowDropButtonWhen = fmShowDropButtonWhenNever
    cPATH1 = "C:\Maintenance Passon\"
    cPATH2 = "\\your path\ Passon\"
        dCD1 = ActiveDocument.Words(2)
        dCD2 = ActiveDocument.Words(3)
        dCD3 = ActiveDocument.Words(4)
        dCD4 = ActiveDocument.Words(5)
        dCD5 = ActiveDocument.Words(6)
        dCD6 = ActiveDocument.Words(12)
        dCD = dCD1 & dCD2 & dCD3 & dCD4 & dCD5 & dCD6
            myDocname1 = cBO1.Value
            myDocname2 = cBO2.Value
            myDocname3 = cBO3.Value
            myDocname4 = dCD
    FinalFileName = myDocname4 & "-" & myDocname2 & "-" & myDocname3 & "-" & myDocname1
            myDocname = cPATH1 & FinalFileName
    ActiveDocument.SaveAs FileName:=myDocname, FileFormat:=wdFormatDocument, ReadOnlyRecommended:=False
            myDocname = cPATH2 & FinalFileName
    ActiveDocument.SaveAs FileName:=myDocname, FileFormat:=wdFormatDocument, ReadOnlyRecommended:=False
    FinalFileNameWithExt = FinalFileName & ".doc"
        Msg = "Please Use CLOSE & e-Mail Button At Top Of Page Once You Have" & Chr(13) & _
          "" & Chr(13) & _
          "    Finished Typing To Maintain File Name & File Path Syntax." & Chr(13) & _
           "" & Chr(13) & _
          "You Can Save Document Many Times But Only CLOSE & e-Mail ONCE!!"
         
        Title = "   Maintenance PassOn Save Warning"
        Style = vbOKOnly + vbExclamation
    Response = MsgBox(Msg, Style, Title)
    End Sub

    Private Sub CommandButton2_Click() 'CLOSE Function
    Call CloseThisDocWarning  'Prompt for close or leave open
    End Sub

    Sub GoAheadAndClose()
    Dim Msg, Style, Title, Response
            Msg = "You Must Save File and / or Changes" & Chr(13) & _
            "Before Closing Document"
            Title = "Maintenance PassOn CLOSE & e-Mail Warning"
            Style = vbOKOnly + vbExclamation
    With ActiveDocument.Sections(1).Range.Fields
            .Unlink
    End With
        If cBT2 = "DocSaved" Then
            CommandButton1.Locked = False
            CommandButton2.Locked = False
            CommandButton1.Enabled = True
            CommandButton2.Enabled = True
        If Options.CheckGrammarWithSpelling = True Then
            Options.CheckGrammarWithSpelling = False
        Else
            ActiveDocument.CheckSpelling
        End If
    GetRecipList
            ActiveDocument.Close wdSaveChanges
            Else: Response = MsgBox(Msg, Style, Title)
        End If
    End Sub

    Private Sub CloseThisDocWarning()
    Dim Msg, Style, Title, Response
            Msg = "This Will Close and E-mail Your Document!" & Chr(13) & _
            "Is This What You Want??"
            Title = "Maintenance PassOn CLOSE & e-Mail Warning"
            Style = vbYesNo + vbExclamation
            Response = MsgBox(Msg, Style, Title)
        If Response = vbNo Then    ' User chose Yes.
            cBT2 = "NotSaved"
        End
        Else    ' User chose No.
    Call GoAheadAndClose
    End If
    End Sub

    Sub chkpath()
    Set filesys = CreateObject("Scripting.FileSystemObject")
    If Not filesys.FolderExists("C:\Maintenance PassOn\") Then
       newfolder = filesys.CreateFolder("C:\Maintenance PassOn\")
    End If
    End Sub

    Sub GetRecipList()
        OssRecipList = OpenExcelFile("c:\ossreciplist.csv")
        SendToNotesNow
    End Sub

    Function OpenExcelFile(Name As String) As Variant
    Dim oApp As Excel.Application
    Dim oWB As Excel.Workbook
    Dim oWorksheet As Excel.Worksheet
    Set oApp = Excel.Application
    Set oWB = Workbooks.Open(Name)
    Set oWorksheet = oWB.Sheets(1)
    OpenExcelFile = oWorksheet.UsedRange
    oWB.Close
    oApp.Quit
    End Function

    Sub SendToNotesNow()
    Dim Subject As String
    Dim Attachment As String
    Dim Recipient As Variant
    Dim BodyText As String
    Dim SaveIt As Boolean
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    Dim StSignature As String
        Set Session = CreateObject("Notes.NotesSession")
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
        Set Maildb = Session.GetDatabase("", MailDbName)
            If Maildb.IsOpen = True Then
         Else
             Maildb.OPENMAIL
            End If
    StSignature = Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
    BodyText = "Please see attached Maintenance Passon Document for Operations Details."
    Attachment = myDocname & ".doc"
    Subject = FinalFileName
    Recipient = OssRecipList
        Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.Subject = Subject
    MailDoc.Body = BodyText & Chr(13) & _
            "" & Chr(13) & _
            StSignature
    MailDoc.SaveMessageOnSend = True
            If Attachment <> "" Then
                Set AttachME = MailDoc.CreateRichTextItem("Attachment")
                Set EmbedObj = AttachME.EmbedObject(1454, "", Attachment, "Attachment")
            End If
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.Send 0, OssRecipList
        Set Maildb = Nothing
        Set MailDoc = Nothing
        Set AttachME = Nothing
        Set Session = Nothing
        Set EmbedObj = Nothing
    End Sub

    Tuesday, June 5, 2012 11:22 PM