使用Lotus Notes Social Edition Home从Excel数据生成电子邮件[关闭]

2 回答

• 1

  这是发送电子邮件的一种更简单的方式 . 它适用于我，我有Lotus Notes 9所以希望它也适用于您的版本 .

  Sub Send_Email_via_Lotus()
  'Send an e-mail & attachment using Lotus Not(s)
  'Original Code by Nate Oliver (NateO)
  'Declare Variables for file and macro setup
  'Dim AVal As Variant
  Dim UserName As String, MailDbName As String, ccRecipient As String, Recipient As String
  Dim Maildb As Object, MailDoc As Object, Session As Object
  Dim email As String, bodyText As String, clientRef As String, bodyRng As Range, emailBody As String
  Dim notesUIDoc As Object
  
  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
          Call Maildb.OPENMAIL
      End If
  
      Recipient = Sheets("Sheet1").Range("A1").Value
      ccRecipient = Sheets("Sheet1").Range("A2").Value
      Set bodyRng = Sheets("Sheet2").Range("A1:B24")
  
      Dim cel As Range
      For Each cel In bodyRng
          emailBody = emailBody & " " & cel.Value
      Next cel
  
      ' Create New Mail and Address Title Handlers
      Set MailDoc = Maildb.CreateDocument
      MailDoc.Form = "Memo"
      MailDoc.sendTo = Recipient
      MailDoc.CopyTo = ccRecipient
      MailDoc.Subject = "SUBJECT HERE"
  
      'Displays email message without sending; user needs to click Send
      Set workspace = CreateObject("Notes.NotesUIWorkspace")
      Set notesUIDoc = workspace.EditDocument(True, MailDoc)
      'Call notesUIDoc.FieldClear("Body") '' This line will clear the ENTIRE body, including signature.
      Call notesUIDoc.gotofield("Body") 'This should just Go to the body, keeping your signature.
      Call notesUIDoc.FieldAppendText("Body", emailBody)
  
      Set Maildb = Nothing
      Set MailDoc = Nothing
      Set AttachME = Nothing
      Set Session = Nothing
      Set EmbedObj1 = Nothing
  
      .ScreenUpdating = True
      .DisplayAlerts = True
      .EnableEvents = True
  End With
  
  'End If
  Exit Sub
  
  errorhandler1:
  Set Maildb = Nothing
  Set MailDoc = Nothing
  Set AttachME = Nothing
  Set Session = Nothing
  Set EmbedObj1 = Nothing
  Application.EnableEvents = True
  
  End Sub
  

  请注意，附件部分缺乏，我将继续搜索，但这应该让你开始，看看如何使用变量来设置正文，收件人等（可能还有不必要的变量，我没有'检查那些） .

  注意：请查看 For Each cel in bodyRng 循环，因为我不太清楚您希望如何设置正文 .

  回复于 2024-05-11T22:46:53+08:00
• 1

  Sub NotesEmailrun()
  
  Dim UserName As String, MailDbName As String, ccRecipient As String, attachment1 As String
  Dim Maildb As Object, MailDoc As Object, AttachME As Object, Session As Object
  Dim EmbedObj1 As Object
  
  
  With Application
  .ScreenUpdating = False
  .DisplayAlerts = False
  
  
  Set Session = CreateObject("Notes.NotesSession")
  UserName = Session.UserName
  MailDbName = _
  Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
  Set Maildb = Session.GETDATABASE("", "")
  If Maildb.IsOpen = True Then
  Else
  Maildb.OpenMail
  End If
  
  
  Set MailDoc = Maildb.CreateDocument
  MailDoc.Form = "Memo"
  
  MailDoc.Sendto = Sheets("Sheet1").Range("A1").Value
  MailDoc.CopyTo = Sheets("Sheet1").Range("A2").Value
  
  MailDoc.Subject = Sheets("Sheet1").Range("A5").Value
  MailDoc.body = Sheets("Sheet2").Range("A1:H24")
  
  
  MailDoc.SaveMessageOnSend = True
  
  attachment1 = "C:\Users\Username\Desktop\folder1\time.txt"
  If attachment1 <> "" Then
  On Error Resume Next
  Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment1")
  Set EmbedObj1 = AttachME.EmbedObject(1454, "", attachment1)
  On Error Resume Next
  End If
  
  attachment2 = "C:\Users\username\Desktop\folder2\time2.txt"
  If attachment2 <> "" Then
  On Error Resume Next
  Set AttachME = MailDoc.CREATERICHTEXTITEM("attachment2")
  Set EmbedObj1 = AttachME.EmbedObject(1454, "", attachment2)
  On Error Resume Next
  End If
  
  
  Set workspace = CreateObject("Notes.NotesUIWorkspace")
  Call workspace.EditDocument(True, MailDoc).GOTOFIELD("Body")
  
  
  Set Maildb = Nothing
  Set MailDoc = Nothing
  Set AttachME = Nothing
  Set Session = Nothing
  Set EmbedObj1 = Nothing
  
  .ScreenUpdating = True
  .DisplayAlerts = True
  End With
  
  errorhandler1:
  
  Set Maildb = Nothing
  Set MailDoc = Nothing
  Set AttachME = Nothing
  Set Session = Nothing
  Set EmbedObj1 = Nothing
  
  End Sub
  

  回复于 2024-05-11T22:46:53+08:00