電子メール アドレスの表を含む 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, "", ""
しかし、アドレスと添付ファイルの両方を同じメールに含める方法が必要です。