ACCESS EXCELなどから
メーラーを介さずにメールを送信できます

シートやテーブルにメアドリスト作って一斉送信なんかも出来ちゃいます グフッ

拾い物ですが以下コード、VBEのツール→参照設定でmicrosoftCDOにチェックつける必要があります

‘*******************************************************************************
‘ メール送信(CDO)
‘*******************************************************************************
‘ [引数]
‘ ①MailSmtpServer : SMTPサーバ名(又はIPアドレス)
‘ ②MailFrom : 送信元アドレス
‘ ③MailTo : 宛先アドレス(複数の場合はカンマで区切る)
‘ ④MailCc : CCアドレス(複数の場合はカンマで区切る)
‘ ⑤MailBcc : BCCアドレス(複数の場合はカンマで区切る)
‘ ⑥MailSubject : 件名
‘ ⑦MailBody : 本文(改行はvbCrLf付加)
‘ ⑧MailAddFile : 添付ファイル(複数の場合はカンマで区切るか配列渡し) ※Option
‘ ⑨MailCharacter : 文字コード指定(デフォルトはShift-JIS) ※Option
‘ [戻り値]
‘ 正常時:”OK”, エラー時:”NG”+エラーメッセージ
‘*******************************************************************************
Function SendMailByCDO(MailSmtpServer As String, _
MailFrom As String, _
MailTo As String, _
MailCc As String, _
MailBcc As String, _
MailSubject As String, _
MailBody As String, _
Optional MailAddFile As Variant, _
Optional MailCharacter As String)

Const cnsOK = “OK”
Const cnsNG = “NG”
Dim objCDO As Object ‘New CDO.Message
Set objCDO = CreateObject(“CDO.Message”)
Dim vntFILE As Variant
Dim IX As Long
Dim strCharacter As String, strBody As String, strChar As String

On Error GoTo SendMailByCDO_ERR
SendMailByCDO = cnsNG

‘ 文字コード指定の確認
If MailCharacter <> “” Then
‘ 指定ありの場合は指定値をセット
strCharacter = MailCharacter
Else
‘ 指定なしの場合はShift-JISとする
strCharacter = “shift-jis” ‘cdoShift_JIS
End If

‘ 本文の改行コードの確認
‘ Lfのみの場合Cr+Lfに変換
strBody = Replace(MailBody, vbLf, vbCrLf)
‘ 上記で元がCr+Lfの場合Cr+Cr+LfになるのでCr+Lfに戻す
MailBody = Replace(strBody, vbCr & vbCrLf, vbCrLf)

With objCDO
With .Configuration.Fields ‘ 設定項目
.Item(cdoSendUsingMethod) = cdoSendUsingPort ‘ 外部SMTP指定
.Item(cdoSMTPServer) = MailSmtpServer ‘ SMTPサーバ名
.Item(cdoSMTPServerPort) = ********************************** ‘ ポート№
.Item(cdoSMTPConnectionTimeout) = 60 ‘ タイムアウト
.Item(cdoSMTPAuthenticate) = cdoBASIC
.Item(cdoLanguageCode) = strCharacter ‘ 文字セット指定
.Update ‘ 設定を更新
End With
.MimeFormatted = True
.Fields.Update
.FROM = MailFrom ‘ 送信者
.To = MailTo ‘ 宛先
If MailCc <> “” Then .CC = MailCc ‘ CC
If MailBcc <> “” Then .BCC = MailBcc ‘ BCC
.Subject = MailSubject ‘ 件名
.TextBody = MailBody ‘ 本文
.TextBodyPart.Charset = strCharacter ‘ 文字セット指定(本文)
‘ 添付ファイルの登録(複数対応)
If ((varType(MailAddFile) <> vbError) And _
(varType(MailAddFile) <> vbBoolean) And _
(varType(MailAddFile) <> vbEmpty) And _
(varType(MailAddFile) <> vbNull)) Then
If IsArray(MailAddFile) Then
For IX = LBound(MailAddFile) To UBound(MailAddFile)
.AddAttachment MailAddFile(IX)
Next IX
ElseIf MailAddFile <> “” Then
vntFILE = Split(CStr(MailAddFile), “,”)
For IX = LBound(vntFILE) To UBound(vntFILE)
If Trim(vntFILE(IX)) <> “” Then
.AddAttachment Trim(vntFILE(IX))
End If
Next IX
End If
End If
.Send ‘ 送信
End With
Set objCDO = Nothing
SendMailByCDO = cnsOK
Exit Function

‘——————————————————————————-
SendMailByCDO_ERR:
SendMailByCDO = cnsNG & Err.Number & ” ” & Err.Description
On Error Resume Next
Set objCDO = Nothing
End Function

設定事項は使うメアドのアカウント設定を書き込む必要があります

通常は
SendUsingMethod = cdoSendUsingPort ’=2’外部smtp指定
SMTPAuthenticate = cdoBASIC ’=1’smtp認証有り
SMTPServer ’url or IPaddress
SMTPServerPort = 587
SMTPConnectionTimeout = 60 ‘sec
SendUserName = ”*****”
sendPassword = ”*****”
LanguageCode = strCharacter
あたりですね

GMAILは
SendUsingMethod = cdoSendUsingPort ’=2’外部smtp指定
SMTPAuthenticate = cdoBASIC ’=1’smtp認証有り
SMTPServer =”smtp.gmail.com”
SMTPServerPort = 465
SMTPConnectionTimeout = 100 ‘sec
cdosmtpusessl = True
SendUserName = ”*****”
sendPassword = ”*****”
LanguageCode = strCharacter
ですかね