Excel VBA使用IBM Notes从电子邮件地址更改?

时间:2017-01-09 18:22:22

标签: excel vba lotus-notes

我有以下vba代码,它使用IBM Notes从excel发送电子邮件。

但是,我希望能够更改发件人地址。 请问有人能告诉我哪里出错了吗?

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("M:M")) Is Nothing Then
    If Target.Cells.Count < 3 Then


  'Set up the objects required for Automation into lotus notes

    Dim Ref As String
    Dim TrueRef As String



    Ref = Range("H" & (ActiveCell.Row)).Value

    If Ref = "WSM" Then
    TrueRef = "WES"
    Else
    If Ref = "NAY" Then
    TrueRef = "NAY"
    Else
    If Ref = "ENF" Then
    TrueRef = "ENF"
    Else
    If Ref = "LUT" Then
    TrueRef = "MAG"
    Else
    If Ref = "NFL" Then
    TrueRef = "NOR"
    Else
    If Ref = "RUN" Then
    TrueRef = "RUN"
    Else
    If Ref = "SOU" Then
    TrueRef = "SOU"
    Else
    If Ref = "SOU" Then
    TrueRef = "SOU"
    Else
    If Ref = "BRI" Then
    TrueRef = "BRI"
    Else
    If Ref = "LIV" Then
    TrueRef = "LIV"
    Else
    If Ref = "BEL" Then
    TrueRef = "BEL"
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If




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

    Dim nMailBody As String
    Dim nMailSubject As String
    Dim nMailRecipient As Variant
    Dim nMail As Object
    Dim nSession As Object
    Dim nDatabase As Object
    Dim nMime As Object
    Dim nMailStream As Object
    Dim nChild As Object
    Dim nSomeMailBodyText As String
    Dim amountOfRecipients As Integer

    nSomeMailBodyText = "<p>Hello,</p><br><p>How are you?</p>"


    nMailSubject = "A great email"

    Set nSession = CreateObject("Notes.NotesSession")
    Set nDatabase = nSession.GETDATABASE("", "")
    Call nDatabase.OPENMAIL
    Set nMail = nDatabase.CREATEDOCUMENT




    nMail.Principal = "bogus_user@example.com"

    nMail.SendTo = "mark.obrien@lidl.co.uk"
    nMail.subject = "This is test"

    nSession.CONVERTMIME = False
    Set nMime = nMail.CREATEMIMEENTITY
    Set nMailStream = nSession.CREATESTREAM


    'vBody contient le texte au format Html
    Call nMailStream.WRITETEXT(nSomeMailBodyText)
    Call nMailStream.WRITETEXT(" - and again - ")
    Call nMailStream.WRITETEXT(nSomeMailBodyText)
    Call nMailStream.WRITETEXT("<br>")
    Call nMailStream.WRITETEXT("<br>")



    '----- READ AND PASTE SIGNATURE -------------------------------------

    'Get the standard signature location
    nSignatureLocation = nDatabase.GETPROFILEDOCUMENT("CalendarProfile").GETITEMVALUE("Signature")(0)



    Set nChild = nMime.CREATECHILDENTITY
    Call nChild.SETCONTENTFROMTEXT(nMailStream, "text/html;charset=iso-8859-1", ENC_NONE)
    Call nMailStream.Close
    nSession.CONVERTMIME = True



    'Send the document
    nMail.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    nMail.SEND 0, Recipient




    End If
End If

End Sub

2 个答案:

答案 0 :(得分:0)

NotesDocument.Send方法不允许经过身份验证的人欺骗发件人的发件人地址。在Domino服务器上运行的代码可以执行此操作,但您的代码是作为客户端连接的。

有两种解决方法。我将提到第一个,但必须告诉您它不受IBM支持,不推荐 - 特别是对于新手Notes开发人员。它涉及将文档直接写入Domino路由器邮箱(mail.box),而不是使用NotesDocument.Send方法。

第二种方法是使用在Domino服务器上运行的代码来发送电子邮件。实现此目的的一种方法是让您的代码将NotesDocument保存在Domino服务器上的数据库中,并在该数据库中设置后台代理程序,该代理程序设置为在创建新文档时运行。代理中的代码将设置Principal字段,我看到你已尝试过 - 但正如我上面所说,使用NotesDocument.send在客户端代码中运行时它不起作用。还有很多其他方法。

答案 1 :(得分:0)

正如理查德已经说过的那样,除非你使用那种未记录的方法,否则你不能像这样欺骗客户端。我有一个用于邮件通知的Notes类(可以在我的博客上找到),但是Richard是正确的,因为你作为初学者(根据你发布的代码很清楚)可能不应该尝试使用该方法。

另外,为什么你使用这种复杂的方式来设置TrueRef的值? 你不能使用Select Case语句吗?或者甚至只是简化你的代码:

TrueRef = Ref
If Ref = "WSM" Then
    TrueRef = "WES"
ElseIf Ref = "LUT" Then
    TrueRef = "MAG"
ElseIf Ref = "NFL" Then
    TrueRef = "NOR"
End If

If Ref = "WSM" Then
    TrueRef = "WES"
ElseIf Ref = "LUT" Then
    TrueRef = "MAG"
ElseIf Ref = "NFL" Then
    TrueRef = "NOR"
Else
    TrueRef = Ref
End If