使用VBA将电子邮件发送到特定的Lotus Notes联系人

时间:2014-09-19 12:40:52

标签: vba email excel-vba lotus-notes excel

我有A'列A'有不同的名字。我有所有这些人在我的莲花笔记帐户中发送电子邮件联系人我想向多个收件人发送电子邮件(包括A栏中的人员)。我的意思是:

    column A:        
    Ludvig Simpson        
    Matthew Ricky        
    Anne Cameron  
    etc...              

例如Ludvig Simpson有这个莲花电子邮件地址:dbyw4680,Matthew Ricky有cjua321,Anne Cameron有db1621。所有这些电子邮件地址仅在我的莲花帐户中找到。

我的问题:如何向Ludvig,Matthew和Anne发送电子邮件?(我的意思是如何自动从Lotus发送他们的地址邮件?)。要指定'列A'中的名称与我莲花账户中的名字相同。

我不想逐个将他们的电子邮件地址放在一个范围/列中,因为人名列表是恐怖的,变化,可以增长。

你有什么想法吗?

以下是我的代码,它将消息发送给从A列获取的多个收件人:

    Sub sendEmail()        
    Dim noSession As Object, noDatabase As Object, noDocument As Object
    Dim obAttachment As Object, EmbedObject As Object
    Dim stSubject As Variant, stAttachment As String
    Dim vaRecipient As Variant
    Dim vaMsg As Variant

    Const EMBED_ATTACHMENT As Long = 1454
    Const stTitle As String = "Status Active workbook"
    Const stMsg As String = "The active workbook must first be saved " & vbCrLf _
     & "before it can be sent as an attachment."

   'If the active workbook has not been saved at all.
    If Len(ActiveWorkbook.Path) = 0 Then
        MsgBox stMsg, vbInformation, stTitle
        Exit Sub
    End If

    Dim x As Integer
    For x = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        'Get the name of the recipient from the user.
        vaRecipient = Worksheets("Sheet1").Range("A" & x).Value

    Do 'Get the message from the user.
           vaMsg = "My email text"
    Loop While vaMsg = ""
    If vaMsg = False Then Exit Sub   'If the user has canceled the operation.

    'Add the subject to the outgoing e-mail which also can be retrieved from the users
    'in a similar way as above.
     stSubject = "My subject email"

    'Retrieve the path and filename of the active workbook.
     stAttachment = ActiveWorkbook.FullName

    'Instantiate the Lotus Notes COM's Objects.
     Set noSession = CreateObject("Notes.NotesSession")
     Set noDatabase = noSession.GETDATABASE("", "")

     'If Lotus Notes is not open then open the mail-part of it.
      On Error Resume Next
      If noDatabase.IsOpen = False Then noDatabase.OPENMAIL

    'Create the e-mail
     Set noDocument = noDatabase.CreateDocument

    'Add values to the created e-mail main properties.
     With noDocument
        .Form = "Memo"
        .sendto = vaRecipient
        .Subject = stSubject
        .Body = vaMsg
        .SaveMessageOnSend = True
     End With

    'Send the e-mail.
     Dim myMessage As String
     myMessage = MsgBox("Are you sure you want to send the email?", vbYesNo, "Are you sure?")

     If myMessage = vbYes Then
         With noDocument
             .PostedDate = Now()
             .SEND 0, vaRecipient
         End With
    'Release objects from the memory.
    Set EmbedObject = Nothing
    Set obAttachment = Nothing
    Set noDocument = Nothing
    Set noDatabase = Nothing
    Set noSession = Nothing

       'Activate Excel for the user.
       AppActivate "Microsoft Excel"

          MsgBox "The e-mail has successfully been created and distributed.", vbInformation, "Done!"
      Else
       MsgBox "Unsent email!", vbInformation, "Unsent email"
      End If
     Next x
  End Sub

0 个答案:

没有答案