Function sendMail(MailSubject As String, MailBody As String, ToAddress As String, _
Optional CcAddress As String = vbNullString, Optional BccAddress As String = vbNullString, Optional attFile As Variant = vbNullString)
Const mailUser As String = "<Gmailのメアド>"
Const mailPass As String = "<アプリパスワード>"
Dim cdoMsg As Object: Set cdoMsg = CreateObject("CDO.Message")
Dim objFso As Object: Set objFso = CreateObject("Scripting.FileSystemObject")
Dim i As Long
With cdoMsg
With .Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/languagecode") = "shift-jis" '---文字コード指定
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 '---外部SMTP指定
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" '---SMTPサーバ名
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = "465" '---ポート№
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = True '---SMTP認証
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True '---SSL
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60 '---タイムアウト
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = mailUser '---ユーザー
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = mailPass '---パスワード
.Update
End With
.Subject = MailSubject
.TextBody = MailBody
.TextBodyPart.Charset = "ISO-2022-JP"
.From = mailUser
.To = ToAddress
.CC = CcAddress
.BCC = BccAddress
'---添付ファイルが複数(配列形式)かの分岐
If IsArray(attFile) = True Then
For i = LBound(attFile) To UBound(attFile)
'---ファイルが存在してれば添付する
If objFso.FileExists(attFile(i)) Then
.AddAttachment attFile(i)
End If
Next
Else
'---ファイルが存在してれば添付する
If objFso.FileExists(attFile(i)) Then
.AddAttachment attFile(i)
End If
End If
.Send
End With
Set cdoMsg = Nothing
Set objFso = Nothing
End Function
コメント
コメント一覧 (2件)
この記事を読んでGmailのSMTPサーバーに送れるようになりました。
大変ありがとうございました。
さらに、私のBlogにも引用させてもらいました。
→ https://automated.jp/blog/
コメントありがとうございます!
始めて他のサイトへ引用していただきました
久しぶりに触ると仕様が変わってて私も沼ってしまったので力になれてよかったです!