如何打开Lotus Notes新邮件并发送

时间:2016-11-07 09:38:44

标签: excel macros lotus-notes lotus-domino

我见过几个用于加载Lotus Notes并将附件放入并发送出去的宏。 它几乎完成它发送电子邮件,但不知道如何发送文件夹,它使用PDF文件,但我有一堆PDF文件在我想发送的文件夹中。 如何格式化要阅读的电子邮件: " 你好

请查找附件

(附件)

签名 "

感谢任何帮助,谢谢

 Sub SendEmail()
 Dim WatchRange As Range
 Dim IntersectRange As Range
Dim x As Integer
Dim UserName As String
Dim MailDbName As String
Dim Recipient As Variant
Dim Maildb As Object
Dim MailDoc As Object
Dim Attachment As String
Dim Session As Object
Dim stSignature As String
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Open and locate current LOTUS NOTES User
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
' Create New Mail and Address Title Handlers
 Set MailDoc = Maildb.CREATEDOCUMENT
 MailDoc.Form = "Memo"
 Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
' Select range of e-mail addresses
 MailDoc.SendTo = "joe bloggs"
 MailDoc.subject = "Work"
 MailDoc.Body = "Hello" & " " & " Please find attachment."
 MailDoc.SAVEMESSAGEONSEND = True
 Attachment = "c:\03-11\4267.pdf"
 If Attachment <> "" Then

    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "")
    On Error Resume Next
    MailDoc.CREATERICHTEXTITEM ("Attachment")
End If

  MailDoc.PostedDate = Now()
  On Error GoTo errorhandler1
 MailDoc.SEND 0, Recipient
 Set Maildb = Nothing
 Set MailDoc = Nothing
 Set Session = Nothing
 .ScreenUpdating = True
 .DisplayAlerts = True
  On Error GoTo errorhandler1
  Set Maildb = Nothing
  Set MailDoc = Nothing
  Set Session = Nothing
 End With
 End Sub

我已经改变了我的宏,它现在添加了签名但格式错误且它没有附加文件。

    Sub SendEmail()

  Dim WatchRange As Range
  Dim IntersectRange As Range
  Dim x As Integer
  Dim UserName As String
  Dim MailDbName As String
  Dim Recipient As Variant
 Dim Maildb As Object
 Dim MailDoc As Object
 Dim Attachment As String
 Dim Session As Object
  Dim stSignature As String
 Dim ws As Object 'Lotus Workspace


  Dim objProfile As Object
  Dim rtiSig As Object, rtitem As Object, rtiNew As Object
  Dim uiMemo As Object
  Dim strToArray() As String, strCCArray() As String, strBccArray() As String
 Dim strTo As String, strCC As String, strBcc As String, _
 strObject As String, strBody As String, strAttachment As String, blnSaveit As   Boolean
   Dim strSignText As String, strMemoUNID As String
   Dim intSignOption As Integer


  With Application
  .ScreenUpdating = False
   .DisplayAlerts = False
   ' Open and locate current LOTUS NOTES User
   Set Session = CreateObject("Notes.NotesSession")
   Set ws = CreateObject("Notes.NotesUIWorkspace")

   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
    ' Create New Mail and Address Title Handlers


    Set MailDoc = Maildb.CREATEDOCUMENT
     MailDoc.Form = "Memo"
   stSignature =                        Maildb.GetProfileDocument("CalendarProfile").GetItemValue("Signature")(0)
  ' Select range of e-mail addresses
    MailDoc.SendTo = "JJunoir"
     MailDoc.subject = ""
     MailDoc.Body = "Hello" & " " & " Please find attachment,"
      MailDoc.SAVEMESSAGEONSEND = True


      Set objProfile = Maildb.GETPROFILEDOCUMENT("CalendarProfile")
      intSignOption = objProfile.GETITEMVALUE("SignatureOption")(0)
      strSignText = objProfile.GETITEMVALUE("Signature")(0)


      Attachment = "c:\Debit Notes 03-11\"
     If strAttachment <> "" Then
    Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
    Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", strAttachment,     "Attachment")
    On Error Resume Next
    MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If


   'Open memo in ui
   Set uiMemo = ws.EDITDOCUMENT(True, MailDoc)
   Call uiMemo.GotoField("Body")

   'Check if the signature is automatically inserted
   If objProfile.GETITEMVALUE("EnableSignature")(0) <> 1 Then
   If intSignOption = 2 Then
   Call uiMemo.ImportItem(objProfile, "Signature_Rich")
    End If
    End If

   Call uiMemo.GotoField("Body")
   'Save the mail doc
   strMemoUNID = uiMemo.DOCUMENT.UNIVERSALID
    uiMemo.DOCUMENT.MailOptions = "0"
   Call uiMemo.Save
   uiMemo.DOCUMENT.SaveOptions = "0"
   Call uiMemo.Close
   Set uiMemo = Nothing
   Set MailDoc = Nothing

   'Get the text and the signature
   Set MailDoc = Maildb.GETDOCUMENTBYUNID(strMemoUNID)
   Set rtiSig = MailDoc.GETFIRSTITEM("Body")
   Set rtiNew = MailDoc.CREATERICHTEXTITEM("rtiTemp")
   Call rtiNew.APPENDTEXT(strBody)
   Call rtiNew.APPENDTEXT(Chr(10)): Call rtiNew.APPENDTEXT(Chr(10))
   Call rtiNew.APPENDRTITEM(rtiSig)
  'Remove actual body to replace it with the new one
  Call MailDoc.RemoveItem("Body")
  Set rtitem = MailDoc.CREATERICHTEXTITEM("Body")
  Call rtitem.APPENDRTITEM(rtiNew)

  MailDoc.Save False, False
  Set uiMemo = ws.EDITDOCUMENT(True, MailDoc)


   MailDoc.PostedDate = Now()
   On Error GoTo errorhandler1
   MailDoc.SEND 0, Recipient
   Set Maildb = Nothing
   Set MailDoc = Nothing
   Set Session = Nothing
  .ScreenUpdating = True
  .DisplayAlerts = True
  errorhandler1:
  Set Maildb = Nothing
  Set MailDoc = Nothing
  Set Session = Nothing
  End With
  End Sub

这是它产生的没有附件的东西 亲切的问候 J JuniorHello请找附件,

1 个答案:

答案 0 :(得分:1)

如果您的目标是操纵Lotus Notes客户端用户界面,那么您可以使用&#34; Notes.NotesSession&#34;而不是&#34; Lotus.NotesSession&#34;。 &#34; Notes。&#34;前缀为您提供OLE classes而不是您将使用&#34; Lotus&#34;获得的COM类。前缀,你肯定需要使用OLE类 - 但你仍然选择了错误的根对象。

NotesSession类和从它下载的所有类(在OLE和COM类中都可用)被称为&#34;后端类&#34;,这意味着它们不会操纵用户接口。

你需要使用&#34;前端类&#34;如果你想操纵UI,那么根对象就是&#34; Notes.NotesUIWorkspace&#34;。在许多情况下,您可能会发现需要后端和前端类的组合。例如,NotesUIWorkspace.EditDocument(前端)采用NotesDocument(后端)参数,允许您通过在幕后找到它来打开您找到的文档的UI。 / p>