0

電子メール アドレスの表を含む Word 文書があります。ドキュメントからアドレスを取得し、「To:」フィールドにアドレスが追加され、ドキュメントが添付ファイルとして含まれるデフォルトの電子メール サービスとして設定されている 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