将Excel图表发布到Lotus Notes电子邮件中

时间:2013-02-01 20:26:21

标签: excel vba email charts lotus-notes

好的,刚刚进入VBA,我已经被送到了doosie。我试图从Excel中的工作表中获取一个图表,放入Lotus Notes。我已经尝试将它作为一个富文本格式附加(你可以从注释掉的区域看到)和JPEG(我最近的尝试。电子邮件很好。正文文本按照预期的方式进行。我不能将图表放入电子邮件正文中。我真的可以使用一些帮助。这就是我所拥有的:

    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 attachMe As Object
   ' Dim Attachment1 As String
   ' Dim EmbedObj1 As Object
   ' Dim Chart1 As Object
    Dim Fname As String




    User = Application.UserName

     ' setting up all sending recipients
    recipient = "Someoneelse@somewhere.com"
     '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 a display at the bottom" & vbLf & _
               " that gives you your WTD Margin Percentage.  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") & "\GM%.jpeg"

    Sheets("Chart").Shapes("Chart 2").Chart.ChartArea.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
'    If Attachment1 <> "" Then
'        Set attachMe = MailDoc.CREATERICHTEXTITEM("Attachment1")
'        Set EmbedObj1 = attachMe.EmbedObject(1454, "", Attachment1, "Attachment")
'        MailDoc.CREATERICHTEXTITEM ("Attachment")
'    End If

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


    MailDoc.Send 0, recipient

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

     'Unload Me
    Exit Sub
End Sub

1 个答案:

答案 0 :(得分:3)

这应该在MailDoc.Send

之前工作
Dim rtitem As Object
Dim object As Object

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