FC2ブログ

メール送信(Windows標準のCDOオブジェクトを利用)について

メール送信(Windows標準のCDOオブジェクトを利用)

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

下記の説明でうまくいかない場合は、サンプルをお試しください。
⇒ って、これもブログにサンプルを移植できませんでした。m(__)m

#Region "■■■ 定数宣言 ■■■"

  '--------------------------------------------------
  ' 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 cdoBasic = 1
  Private Const cdoNTLM = 2
  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"

#End Region


#Region "■■■ 変数宣言 ■■■"

  '--------------------------------------------------
  ' Mail関連
  '--------------------------------------------------

  Public Structure objMail
    Public objFrom As String       '差出人
    Public objSMTPServer As String    'SMTPサーバ
    Public objSMTP_FLG As Boolean    'SMTPサーバ認証
    Public objUserName As String     'SMTPサーバ認証:ユーザ名
    Public objPassWord As String     'SMTPサーバ認証:パスワード
    Public objTo As String        '宛先(複数指定はセミコロン(;)区切りで指定可)
    Public objCC As String        'CC(複数指定はセミコロン(;)区切りで指定可)
    Public objBCC As String       'BCC(複数指定はセミコロン(;)区切りで指定可)
    Public objSubject As String     '件名
    Public objBody As String       '本文
    Public objAttachment() As String   '添付ファイル
  End Structure

#End Region


#Region "■■■ 関数 ■■■"
  '==============================================================================
  '
  ' メール送信
  '
  ' ------------------------------------------------------------------------
  ' 説明 : メールオブジェクトの内容にしたがってメールを送信する
  '
  ' ------------------------------------------------------------------------
  ' 引数 : objMailSet     メールオブジェクトセット
  '    strErrMsg      エラーメッセージ
  ' 戻値 : True:成功、False:失敗
  '
  '==============================================================================

  Public Function fncMailSend(ByVal objMailSet As objMail, _
                Optional ByRef strErrMsg As String = "") As Boolean

    Dim oMsg As Object
    Dim intCnt As Integer

    Try

      '--------------------------------------------------
      ' メール送信
      '--------------------------------------------------

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

      'CDOオブジェクト設定&送信
      With oMsg
        '差出人
        .From = objMailSet.objFrom

        '宛先,件名,本文設定
        .To = objMailSet.objTo
        .CC = objMailSet.objCC
        .BCC = objMailSet.objBCC
        .Subject = objMailSet.objSubject
        .TextBody = objMailSet.objBody

        '添付ファイル設定
        For intCnt = 0 To objMailSet.objAttachment.GetUpperBound(0)
          If objMailSet.objAttachment(intCnt).ToString <> "" Then
            .AddAttachment(objMailSet.objAttachment(intCnt).ToString)
          End If
        Next

        'SMTPサーバ設定
        If objMailSet.objSMTPServer <> "" Then
          With .Configuration.Fields

            'SMTPサーバ
            .Item(cdoSendUsingMethod) = cdoSendUsingPort
            .Item(cdoSMTPServer) = objMailSet.objSMTPServer
            .Item(cdoSMTPServerPort) = 25

            'SMTP認証
            If objMailSet.objSMTP_FLG Then
              .Item(cdoSMTPAuthenticate) = cdoAnonymous
              .Item(cdoSendUserName) = objMailSet.objUserName
              .Item(cdoSendPassword) = objMailSet.objPassWord
            End If

            '設定更新
            .Update()
          End With
        End If

        'メール送信
        .Send()

      End With

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


      '--------------------------------------------------
      ' 戻り値設定
      '--------------------------------------------------

      Return True

    Catch ex As Exception

      '--------------------------------------------------
      ' エラーメッセージ設定
      '--------------------------------------------------

      strErrMsg = "メール送信中にエラーが発生しました。" & vbCrLf & _
            "ネットワーク管理者(プロバイダ)にお問い合わせください。" & vbCrLf & _
            "詳細は以下のとおり" & vbCrLf & _
            ex.Message


      '--------------------------------------------------
      ' 戻り値設定
      '--------------------------------------------------

      Return False

    End Try

  End Function
#End Region



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

タイトルロゴ3

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

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

コメントの投稿

非公開コメント

検索フォーム
最新記事
カテゴリ
全記事表示リンク

全ての記事を表示する

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

ITLife

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

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

カレンダー
07 | 2019/08 | 09
- - - - 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 31
訪問数
月別アーカイブ
リンク