将图表嵌入Lotus Notes电子邮件正文中

时间:2013-02-01 22:44:48

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

感谢Stack Overflow用户,他帮助我将此图表放入电子邮件的附件中。非常感谢。我的下一步是尝试将其作为图像或副本进入电子邮件的实际主体。当附件工作时,在身体中呈现会更好,除了电子邮件之外没有任何东西可以打开。有人有什么建议吗?我没有听到很多关于尝试用Lotus做这件事的好事。

Sub SendEmail()
  ' setting up various objects
    Dim Maildb As Object
    Dim UserName As String
    Dim MailDbName As String
    Dim MailDoc As Object
    Dim Session As Object
    Dim recipient As String
    Dim ccRecipient As String
    Dim bccRecipient As String
    Dim subject As String
    Dim bodytext As String
    Dim User As String
    Dim Fname As String




    User = Application.UserName

     ' setting up all sending recipients
    recipient = "Someonelse@somewhereelse"
     'ccRecipient =Someoneelse@Somewhereelse.com
     'bccRecipient = ""
    subject = "Week-To-Date GM%"
    bodytext = "" & vbLf & _
               "" & vbLf & _
               "Here is a breakdown of your total GM% for this week.  The graph gives you the GM% by day, with the WTD% displayed as " & vbLf & _
               "individual points on the graph.  We will continue to develop this report for you to provide you with better information."




     ' creating a notes session
    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
        On Error Resume Next
        Maildb.OPENMAIL
    End If

    Set MailDoc = Maildb.CreateDocument
    MailDoc.Form = "Memo"

    Fname = Environ$("temp") & "\GM1%.jpeg"

    Sheets("Chart").Shapes("Chart 2").Chart.Export Filename:=Fname, FilterName:="JPEG"

     ' loading the lotus notes e-mail with the inputed data
    With MailDoc
        .SendTo = recipient
         '.copyto = ccRecipient
         '.blindcopyto = bccRecipient
        .subject = subject
        .Attachment.Add Fname
        .Body = bodytext
    End With


     ' saving message (Change to True if you want to save it)
    MailDoc.SaveMessageOnSend = False

       Attachment1 = Worksheets("Chart").Shapes("Chart 2").ChartArea

     ' send e-mail
    MailDoc.PostedDate = Now()
     ' if error in attachment or name of recipients

        Dim rtitem As Object
        Dim object As Object

        Set rtitem = MailDoc.CreateRichTextItem("Attachment1")
        Set object = rtitem.EmbedObject(1454, "", Fname)

    MailDoc.Send 0, recipient

    Kill (Fname)

    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set attachMe = Nothing
    Set Session = Nothing
    Set EmbedObj1 = Nothing

     'Unload Me
    Exit Sub
End Sub

1 个答案:

答案 0 :(得分:2)

我相信你只需要将1454更改为1453以嵌入对象而不是附件。

要将其添加到正文中,请将创建富文本项的行更改为:

Set rtitem = MailDoc.CreateRichTextItem("Body")

如果您需要在电子邮件正文中添加文字,可以使用

rtitem.AppendText("text")