下から9行目あたりの.sendをコメントアウトしておいて、下書きフォルダに溜め込んでおいて、内容を確認しながら送信しても良いかも。
Option Explicit
Sub test()
Call Send_Mail("recipient@example.co.jp", "cc_recipient@example.co.jp", "bcc_recipient@example.co.jp", "test subject", "D:\tmp\aaaa.txt", "<HTML><BODY>test message</BODY></HTML>", "sender@example.com")
'複数の宛先を入れる場合は、;で区切る。
End Sub
Sub Send_Mail(ByVal s_TO As String, ByVal s_CC As String, ByVal s_BCC As String, ByVal s_subject As String, ByVal s_PathToAttachment As String, ByVal s_body As String, ByVal s_sender As String)
Dim objOutlook As Outlook.Application
Dim myNamespace As Outlook.Namespace
Dim myInbox As Variant
Dim objMail As MailItem
Dim b_isOutlookAvailable As Boolean
Err.Clear
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Err.Clear
Set objOutlook = CreateObject("Outlook.Application")
b_isOutlookAvailable = False
Else
b_isOutlookAvailable = True
End If
Set myNamespace = objOutlook.getNamespace("MAPI")
Set myInbox = myNamespace.getDefaultFolder(olFolderInbox)
'Set myInbox = objOutlook.getNamespace("MAPI").getDefaultFolder(olFolderInbox)
If b_isOutlookAvailable = False Then
myInbox.Display
End If
objOutlook.WindowState = xlMinimized
Set objMail = objOutlook.createitem(olMailItem)
With objMail
.to = s_TO
.cc = s_CC
.bcc = s_BCC
.Subject = s_subject
.HTMLbody = s_body
.bodyFormat = olFormatHTML
.attachments.Add (s_PathToAttachment)
.SentOnBehalfOfName = s_sender
.Save
.Display
'ここで、送信内容を確認させると良いかも↓
'注意：これは例。少なくともobjOutlookを閉じるコードを入れること。
'If MsgBox("メールの下書きができました。" & vbCrLf & "このメールを送信しますか？", vbYesNo) <> vbYes Then Exit Sub
.send
End With
Set objMail = Nothing
Set myInbox = Nothing
Set myNamespace = Nothing
Set objOutlook = Nothing
'objOutlook.Quit
End Sub
参考
https://qiita.com/salmonosushi/items/7f63eb2e59d9c9cd01a6
https://www.slipstick.com/developer/code-samples/send-email-address-vba/
0 件のコメント:
コメントを投稿