0

我有一个 Word 文档，其中包含一个带有电子邮件地址的表格。我想从文档中获取地址并打开一个 Lotus Notes 电子邮件，该电子邮件设置为默认电子邮件服务，将地址添加到“收件人：”字段并将文档作为附件。我已经连接到 Lotus Notes，我只想让邮件开始有地址和附件，而不是自动发送。我有从表中获取地址的代码：

Sub Send_mail_recipients()

'NiMo 08-Jun-2013
'Send-mail to distribution list

Dim Text As String
Dim char As String
Dim rowcount, n_address, n_cells, Cell_Crt, CharNo As Integer
Dim Recipient(100) As Variant


'With Application.ActiveWindow.Document
'Activate the Document
'n_address = 0
Text = ""
ActiveDocument.Tables(2).Select
n_cells = Selection.Cells.Count

   For Cell_Crt = 1 To n_cells
    If Selection.Cells(Cell_Crt).Range.Text Like "*@*" Then
        'Recipient(n_address) = Selection.Cells(Cell_Crt).Range.Text
        Text = Text + Selection.Cells(Cell_Crt).Range.Text + ", "
        'n_address = n_address + 1

    End If
   'Text = Selection.Cells(Cell_Crt).Range.Text
   Next

Visual basic 提供了一种方法来打开包含文档作为附件的邮件：

'If n_address = 0 Then
If Text = "" Then
    myerrmessage = MsgBox("The Document has no email addresses!", vbOKOnly, "error")
Else
    Options.SendMailAttach = True

    ActiveDocument.SendMail

我发现了另一个函数，它将我作为参数提供的电子邮件地址添加到邮件中：

Private Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation _
As String, ByVal lpFile As String, ByVal lpParameters _
As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long

Private Function OpenEmail(ByVal EmailAddress As String, _
Optional Subject As String, Optional Body As String) _
As Boolean

Dim lWindow As Long
Dim lRet As Long
Dim sParams As String

sParams = EmailAddress
If LCase(Left(sParams, 7)) <> "mailto:" Then _
    sParams = "mailto:" & sParams

If Subject <> "" Then sParams = sParams & "?subject=" & Subject

If Body <> "" Then
    sParams = sParams & IIf(Subject = "", "?", "&")
    sParams = sParams & "body=" & Body
End If

lRet = ShellExecute(lWindow, "open", sParams, _
vbNullString, vbNullString, SW_SHOW)

 OpenEmail = lRet = 0

End Function

OpenEmail Text, "", ""

但是我需要一种方法来在同一封邮件中同时包含地址和附件。

4

1 回答 1

1

这是我过去用来处理笔记的功能。不需要输入密码等 afaik。

Sub SendNotesMail(Subject As String, Attachment As String, Recipient As Variant, BodyText As String, SaveIt As Boolean)
'Public Sub SendNotesMail(Subject as string, attachment as string,
'recipient as string, bodytext as string,saveit as Boolean)
'This public sub will send a mail and attachment if neccessary to the
'recipient including the body text.
'Requires that notes client is installed on the system.

'Set up the objects required for Automation into lotus notes
    Dim Maildb As Object 'The mail database
    Dim UserName As String 'The current users notes name
    Dim MailDbName As String 'THe current users notes mail database name
    Dim MailDoc As Object 'The mail document itself
    Dim AttachME As Object 'The attachment richtextfile object
    Dim Session As Object 'The notes session
    Dim EmbedObj As Object 'The embedded object (Attachment)
    'Start a session to notes
    Set Session = CreateObject("Notes.NotesSession")
    'Next line only works with 5.x and above. Replace password with your password
    'Get the sessions username and then calculate the mail file name
    'You may or may not need this as for MailDBname with some systems you
    'can pass an empty string or using above password you can use other mailboxes.
    UserName = Session.UserName
    MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
    'Open the mail database in notes
    Set Maildb = Session.GETDATABASE("", MailDbName)
     If Maildb.IsOpen = True Then
          'Already open for mail
     Else
         Maildb.OPENMAIL
     End If
    'Set up the new mail document
    Set MailDoc = Maildb.CREATEDOCUMENT

    MailDoc.Form = "Memo"
    MailDoc.sendto = Recipient
    MailDoc.Subject = Subject
    MailDoc.body = BodyText
    MailDoc.SAVEMESSAGEONSEND = SaveIt
    'Set up the embedded object and attachment and attach it
    If Attachment <> "" Then
        Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment")
        Set EmbedObj = AttachME.EMBEDOBJECT(1454, "", Attachment, "Attachment")
'        MailDoc.CREATERICHTEXTITEM ("Attachment")
    End If
    'Send the document
    MailDoc.PostedDate = Now() 'Gets the mail to appear in the sent items folder
    MailDoc.SEND 0, Recipient
    'Clean Up
    Set Maildb = Nothing
    Set MailDoc = Nothing
    Set AttachME = Nothing
    Set Session = Nothing
    Set EmbedObj = Nothing
End Sub
于 2013-07-25T03:43:26.177 回答