FC2ブログ

メールの送信(CDO)について

メールの送信(CDO)

CDO(Microsoft Collaboration Data Objects)を利用したメールの送信方法についてです。
CDOの参照設定を行ったほうが,より使い易くなりますが,あえて環境に依存しない方法で
作成しました。この方法だとVB以外にも,Excel(VBA)やWSH(VBScript)でも使用できます。

'==============================================================================
'
' メール送信関連
'
'==============================================================================
  '---定数宣言
'---CDO関連の定数
Private Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing"
Private Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Private Const cdoSMTPServerPort = "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Private Const cdoSMTPConnectionTimeout = "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Private Const cdoSMTPAuthenticate = "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Private Const cdoSendUsingPort = 2
Private Const cdoAnonymous = 0
Private Const cdoShift_JIS = "shift-jis"
Private Const cdoSendUserName = "http://schemas.microsoft.com/cdo/configuration/sendusername"
Private Const cdoSendPassword = "http://schemas.microsoft.com/cdo/configuration/sendpassword"




'---------------------------------------------------
' 利用方法(以下必要に応じてプロシージャに貼り付けて下さい。)
'---------------------------------------------------

  '---<< フォーム透明化 >>
    Dim oMsg As Object
    Dim sSMTPServer As String
    Dim bSMTP_Flg As Boolean
    Dim sUserName As String
    Dim sPassWord As String
    Dim sFrom As String
    Dim sTO As String
    Dim sCC As String
    Dim sBCC As String
    Dim sSubject As String
    Dim sTextBody As String
    Dim vFile As Variant
    Dim sFile As String
    Dim iLoopCnt As Integer
    Dim sErrMsg As String

    On Error GoTo Err

    '---確認
      If MsgBox("メールを送信します。よろしいですか?", vbQuestion + vbYesNo, _
                                   "メール送信(CDO)サンプル") = vbNo Then
        Exit Sub
      End If


    '---メール送信情報取得
      sSMTPServer = "SMTP-Server@aaa.bbb.co.jp(or 999.999.999.999)" 'SMTPサーバ
      bSMTP_Flg = False      'SMTPサーバ:認証有無
      sUserName = "UserName" 'SMTPサーバ:認証用ユーザ名
      sPassWord = "PassWord"  'SMTPサーバ:認証用パスワード


    '---メール送信内容取得
      sFrom = "FromUser@aaa.bbb.co.jp"   '差出人
      sTO = "ToUser@aaa.bbb.co.jp"      '宛先
      sCC = "CCUser@aaa.bbb.co.jp"      'CC
      sBCC = "BCCUser@aaa.bbb.co.jp"    'BCC
      sSubject = "件名を入力して下さい。"  '件名
      sTextBody = "本文を入力して下さい。" '本文


    '---CDOオブジェクト作成
      Set oMsg = CreateObject("CDO.Message")


    '---CDOオブジェクト設定&送信
      With oMsg
        'メール送信情報設定
        If sSMTPServer <> "" Then
          With .Configuration.Fields
            'SMTPサーバ
            .Item(cdoSendUsingMethod) = cdoSendUsingPort
            .Item(cdoSMTPServer) = sSMTPServer 'SMTPサーバ
            .Item(cdoSMTPServerPort) = 25

            ''SMTPサーバ:認証有無判定
            If bSMTP_Flg = True Then
              .Item(cdoSMTPAuthenticate) = cdoAnonymous
              .Item(cdoSendUserName) = sUserName 'SMTPサーバ:認証用ユーザ名
              .Item(cdoSendPassword) = sPassWord  'SMTPサーバ:認証用パスワード
            End If

            '設定更新
            .Update
          End With
        End If

        'メール送信内容設定
        .From = sFrom       '差出人
        .To = sTO          '宛先
        .cc = sCC          'CC
        .bcc = sBCC        'BCC
        .Subject = sSubject    '件名
        .TextBody = sTextBody '本文

        '添付ファイル
        .AddAttachment "C:\aaa\bbb\ccc\001.txt"
        .AddAttachment "C:\aaa\bbb\ccc\002.txt"
        .AddAttachment "C:\aaa\bbb\ccc\003.txt"

        'メール送信
        .Send

      End With


    '---CDOオブジェクト解放
      Set oMsg = Nothing

      MsgBox "メールを送信しました。", vbInformation, "メール送信(CDO)サンプル"

      Exit Sub

  Err:
    '---エラー処理
      sErrMsg = "エラーが発生しました。" & vbCrLf & _
      Err.Number & " " & Err.Description
      MsgBox sErrMsg, vbCritical, "メール送信(CDO)サンプル"
      Exit Sub



【宣伝・・・(*´ω`)】

タイトルロゴ3

 システム葵では、個人様向けでも企業様向けでも、パソコン修理から、パソコン設定、パソコンの使い方、LAN環境構築、ソフトウェア開発まで、様々な実績がありますので、困ったことがあれば、お気軽にご相談下さい。
関連記事

テーマ : プログラミング
ジャンル : コンピュータ

コメントの投稿

非公開コメント

メールサーバーについて

すいません、植木と申します。
もし、ご迷惑でなかったら教えてください。
SMTPサーバを指定しない場合、デフォルトどこのサーバが使用されますでしょうか?
以下のようなプログラムでメール送信できています。
Set oMsg = CreateObject("CDO.Message")
oMsg.From = "free@g.bank.co.jp"
oMsg.To = "aaa@g.bank.co.jp"
oMsg.Subject = "レターの取込状況 "
oMsg.TextBody = ""_
& vbCrLf & "取込実績が0件のレターです。"_
& vbCrLf & "ご確認いただき、不要であれば削除願います。"_
& vbCrLf & "本メールには返信しないでください。"_
& vbCrLf
oMsg.Send

Re: メールサーバーについて

初めまして、システム葵の新井と申します。

ご質問の件ですが、SMTPサーバは必ず指定する必要があると思います。

 .Item(cdoSendUsingMethod) = cdoSendUsingPort
 (cdoSendUsingPort … smtpauthenticate…1/2(Basic認証/NTLM認証)

試していませんが、指定しなければエラーとなると思います。
ただ、プログラムが動作している自身のパソコン/サーバOS上で、SMTP Serviceが動いていれば、
指定しなくてもいけると思います。
検索フォーム
最新記事
カテゴリ
全記事表示リンク

全ての記事を表示する

最新コメント
プロフィール

ITLife

Author:ITLife
システム葵新井聡太です。
東京都東村山市に生まれ、ここで育ち、ここで結婚し、システムエンジニア一筋で十数年やってきました。
ここでは主に、パソコンを中心にITに関わることを備忘録として残していきたいと思います。
少しでも来ていただいた方のお役に立てたら幸いです。
m(_ _)m

p.s
ここで紹介している内容は一例です。すべては、自己責任でお願いします。

カレンダー
05 | 2019/06 | 07
- - - - - - 1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 - - - - - -
訪問数
月別アーカイブ
リンク