CDOでメール送信

MSが提唱しているCDOを使ってメールの送信を行なってみます。
Office2003のインストールでCDOが動かなくなる!   Office2003のインストールでCDOが動かなくなる現象があるようです。
この現象にあたっている方は、こちらをごらん下さい。
他の章をご覧になっていない方のために、少し前フリをしておきます。  VBAでのメール送信の方法はいくつかあり、どれが「絶対」ということはありません。
VBAを扱う方で、何かの仕組みの中に「メール送信」を盛り込もうとされるケースはかなり多いようですが、単純に自分が使っているメールソフトに渡すように考える方がほとんどのようです。「メール = メールソフト」ですから、まあ、当然と言えば当然のことです。
下記の説明にありますが、ここで説明している方法の特徴は、
・作った仕組みの「配布」を考えると、PCに搭載されているメールソフトに影響しない方が良い。
・メールソフトへの外部操作はセキュリティ強化などでブロックされる傾向にある。
・利用者の途中操作が介在せずに送信完了までを一気に行なうことができる。
・本文の編集や、添付ファイルの有無など通常のEメールにできることが制限なく行なえる。
Windows2000以降の限定があるものの、何も追加インストールする必要なし。

などが挙げられます。
ここでの説明画像をクリックすると、説明に使っているサンプルのExcelブック2種がダウンロードできます。 プロシージャの内容は、「SendMailByCDO」がメール送信を行なうサププロシージャ本体でこれはそのまま他のプロジェクトに流用できると思います。 「TEST1」はこれを呼び出す添付ファイルなしのサンプルプロシージャ、「TEST2」は添付ファイルありのサンプルプロシージャです。
送信認証を要求するメールサーバについて   本来、インターネットメールの送信では「ユーザー」「パスワード」といった認証は行ないません。 これは原理が「郵便」と同じであって「誰でも投函できる」という仕組みに倣ったものなのだそうです。
ですが、これがスパムメールの温床になっているわけですから、送信サーバを提供する側が「送信認証」の仕組みを取り入れてくるようになってきています。 「送信認証」の仕組みは種類がいろいろあるようで、さらに「暗号化」を組み合わせることも多いようです。
私は「その筋」の専門家ではないので解説はできませんが、CDOでできる設定をいろいろ試してみて、 自分の環境での送信はできるようになりましたから、送信可能になったコードを公開しました。
「送信認証を行なうメールサーバでの対応」
CDO」とは、何でしょう。
本サイトでは、VBA外部コンポーネントによるメール送受信ができることを以前からお伝えしていました。これについては何も変わりはありませんが、Windows2000の登場と合わせてCDOというものが登場してきました。MSの説明では「Microsoft Collaboration Data Objects」の略で「メッセージング アプリケーションやコラボレーション アプリケーションを構築するためのテクノロジーです。」ということです。
まあ、これでは何だか解らないし、別に他の方法で目的が実現できていればそれでよかったこともありますが、Windows2000の登場から約5年もたった現在に至って取り上げてみようと思います。

というのも、Windows2000の登場に合わせてできていた技術であれば何年も経つのですが、この技術に関するドキュメントをWeb上で探してサンプルなどにヒットするようになったのは2003年位からなのです。
結局のところ、メールの送信に使えるものであって、受信は一切できないようです。ですが、外部コンポーネント利用と違い、何も追加インストールが発生しません。
また、「Windows2000の登場と合わせて」ということで、WindowsNT,9x,MEなどこれ以前のバージョンには対応していません。(私が扱っている環境ではこれがネックでした。)一方、外部コンポーネント(BASP21)の方は現状でWindows95以降で動くこともありますが、何より、メール送信だけでなく、メール受信やFTP送受信、ソケット通信なども行なえる魅力があります。このリンク先で説明している方法は、私のところでは7年以上、600台以上のPCでの安定した稼働の実績があるものです。
ですが、追加コンポーネントのインストールが必要なのは仕方ありません。そこで、Windows2000以降であれば追加コンポーネントのインスト−ルが要らないCDOでのメール送信のサンプルを紹介します。記述方法は、「参照設定」による方法と、参照設定せずにCreateObjectで実行時にバインディングするものの2種類です。

さて、前置きはこの位にして、簡単なサンプルで説明してみましょう。

(この画像をクリックすると、実際にExcel上で動作確認ができます)
まず、赤枠の部分をご自分の環境に合わせて下さい。

SMTPサーバ 送信メールサーバ名、又はIPアドレス(DNSが参照できない場合はIPアドレス)
発信者 発信者のメールアドレス
日本語名を含める場合は"山田太郎 <yamada@hoge.co.jp>"のように
半角の大小記号にメールアドレスを挟んで編集して下さい。
宛先 宛先ののメールアドレス(最初は自分自身としてみて下さい。)
日本語名を含める場合は"山田太郎 <yamada@hoge.co.jp>"のように
半角の大小記号にメールアドレスを挟んで編集して下さい。

最初は、宛先も発信者も自分自身のアドレスにしておくと、送信確認を自分のメールソフトで行なえるので、そのように設定できたら、「送信テスト」をクリックしてみて下さい。
「送信テスト」ボタンは2つあり、1つは添付ファイルなしで確認メッセージだけで送信されます。「添付ファイルあり」の方は「ファイルを開く」のダイアログでファイルを選択した後、同様の確認メッセージの後に送信されます。 「ファイルを開く」のダイアログでは、ShiftCtrlを押しながらファイルを選択することで複数のファイルを添付するように指定できるので、実際に試して下さい。 エラーなどが出なかったら、メールソフトで受信を行なって確認して下さい。

ソースコードです。 実際の送信部分はFunctionプロシージャにしてあり、上記のテスト項目の他、CC、BCC、添付ファイルの指定もできるようにしてあります。できるだけシンプルな記述を採用しています。

'*******************************************************************************
'   CDOでメールを送信する
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
'   [参照設定]
'   ・Microsoft CDO for Windows 2000 Library
'    (or Microsoft CDO for Exchange 2000 Library)
'*******************************************************************************
Option Explicit

'*******************************************************************************
' メール送信テストプログラム
'*******************************************************************************
Sub TEST()
    Dim MailSmtpServer As String
    Dim MailFrom As String
    Dim MailTo As String
    Dim MailSubject As String
    Dim MailBody As String
    Dim strMSG As String

    ' 送信確認
    If MsgBox("メールを送信します。" & vbCr & _
        "SMTP,発信者,宛先等は正しいですか?", vbYesNo) <> vbYes Then Exit Sub
    MailSmtpServer = Cells(1, 2).Text   ' SMTPサーバ
    MailFrom = Cells(2, 2).Text         ' 発信者
    MailTo = Cells(3, 2).Text           ' 宛先
    MailSubject = Cells(4, 2).Text      ' 件名
    MailBody = Cells(5, 2).Text         ' 本文
    ' メール送信(CC,BCCはブランク)
    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody)
    ' 文字コードを任意に指定する場合は以下のようにします。
'    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody, "", cdoISO_2022_JP)
    If strMSG <> "OK" Then MsgBox Mid(strMSG, 3)
End Sub

'*******************************************************************************
' メール送信テストプログラム(添付ファイルあり)
'*******************************************************************************
Sub TEST2()
    Dim MailSmtpServer As String
    Dim MailFrom As String
    Dim MailTo As String
    Dim MailSubject As String
    Dim MailBody As String
    Dim MailAddFile As Variant
    Dim strMSG As String

    ' 添付ファイルの選択
    MailAddFile = Application.GetOpenFilename("全てのファイル (*.*),*.*",, _
        "添付ファイルを選択して下さい。",, True)
    ' 送信確認
    If MsgBox("メールを送信します。" & vbCr & _
        "SMTP,発信者,宛先等は正しいですか?", vbYesNo) <> vbYes Then Exit Sub
    MailSmtpServer = Cells(1, 2).Text   ' SMTPサーバ
    MailFrom = Cells(2, 2).Text         ' 発信者
    MailTo = Cells(3, 2).Text           ' 宛先
    MailSubject = Cells(4, 2).Text      ' 件名
    MailBody = Cells(5, 2).Text         ' 本文
    ' メール送信(CC,BCCはブランク)
    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody, MailAddFile)
    ' 文字コードを任意に指定する場合は以下のようにします。
'    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody, MailAddFile, cdoISO_2022_JP)
    If strMSG <> "OK" Then MsgBox Mid(strMSG, 3)
End Sub

'*******************************************************************************
' メール送信(CDO)
'*******************************************************************************
' [引数]
'  @MailSmtpServer : SMTPサーバ名(又はIPアドレス)
'  AMailFrom       : 送信元アドレス
'  BMailTo         : 宛先アドレス(複数の場合はカンマで区切る)
'  CMailCc         : CCアドレス(複数の場合はカンマで区切る)
'  DMailBcc        : BCCアドレス(複数の場合はカンマで区切る)
'  EMailSubject    : 件名
'  FMailBody       : 本文(改行はvbCrLf付加)
'  GMailAddFile    : 添付ファイル(複数の場合はカンマで区切るか配列渡し) ※Option
'  HMailCharacter  : 文字コード指定(デフォルトはShift-JIS)              ※Option
' [戻り値]
'  正常時:"OK", エラー時:"NG"+エラーメッセージ
'*******************************************************************************
Private 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 New 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 = 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) = 25                   ' ポート
            .Item(cdoSMTPConnectionTimeout) = 60            ' タイムアウト
            .Item(cdoSMTPAuthenticate) = cdoAnonymous       ' 0
            .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

'-----------------------------<< End of Source >>-------------------------------
このような記述です。
最初はもう少し簡単な記述にしたかったのですが、エラーになったり、Excelごとハングしたりと不安定でした。
エラー表示
というのは、「cdoSMTPAuthenticate」などを記述しなくても通常は動作するのですが、私の環境では「会社」はOK、「自宅」はNGでした。この記述にしてからはどちらもOKとなり、Windows2000SP4WindowsXP(Pro)SP2で動作しています。
Windows自体のパッチやサービスパックで動作が変わる可能性があります。私見ですが、安定性では外部コンポーネントに一日に長があるように思えます。
参照設定は以下のように行ないます。
参照設定
Microsoft CDO for Windows 2000 Library」を参照設定しますが、FieldsオブジェクトはADOのメンバだと説明されているので、一応、「Microsoft ActiveX Data Objects 2.x Library」も参照設定に加えておきました。
この状態で、Windows2000SP4WindowsXP(Pro)SP2で問題なく動作しています。

※一部のPCでは、「Microsoft CDO for Windows 2000 Library」は、「Microsoft CDO for Exchange 2000 Library」と表示されるようですが、機能的な差異はないようです。
「Microsoft CDO for Exchange 2000 Library」と表示される場合もあるようです。

CDOのサンプルコードは最近であればあちこちで見つかると思います。
ですが、ほとんどがCreateObjectを使う実行時バインディングの記述です。これは創始的に公開された方法が「そう」であった(ASPなどのスクリプトでの利用を目論んでいた!?)ことと、頻繁に起きるバージョンアップの吸収をねらったもので、処理効率が若干悪くなることと、デバッグが難しいことが問題として揚げられます。
最終的に実行時バインディングを使うのは構いませんが、「最初から」ではなく、まずは参照設定で充分問題点を解決させた上で切り替えれば良いと思います。

Office2003のインストールでCDOが動かなくなる!
Excel2000CDOを利用していた方が、Office2003をインストールしたところCDOが動かなくなったという問い合わせをいただき、以前から掲示板などでやりとりしていた情報を確認したところ、 Outlook2003を標準オプションでインストールすると、CDOのコンポーネントが消されてしまうケースがあるようです。 特に、元々のWindowsの環境で、Outlook Expressを使用していない場合がそのようになるケースのようですが、その復旧は難しくありません。
コントロールパネルから「プログラムの追加と削除」を起動させ、「現在インストールされているプログラム」の「Microsoft Office xxxx Edition 2003」を選択して、「変更」ボタンをクリックします。
「Microsoft Office 2003 セットアップ」を選択
すると、この「Microsoft Office 2003 セットアップ」が起動します。ここでは「機能の追加/削除」を選びます。

「アプリケーションごとにオプションを指定してインストール」にチェックを付ける
インストールするアプリケーションの構成は変更する必要はありませんが、必ず「アプリケーションごとにオプションを指定してインストール」にチェックを付けて下さい。
この画像では「Outlook」にチェックが付いていません。これは私が「Outlook」を使っていなかったからですが、「Outlook」自体を最初からインストールされない場合はCDOが使えなくなるという「事故」には遭わないようです。

「詳細なカスタマイズ」の画面で「Outlook」を開く
「詳細なカスタマイズ」が表示されるので「Microsoft Office Outlook」を開きます。

「Collaboration Data Objects」が×になっている
すると、「Collaboration Data Objects」が×になっているはずなので、このために機能が外されてしまったというわけです。

「マイ コンピュータから実行」を選択
ここで、この「Collaboration Data Objects」について「マイ コンピュータから実行」か「マイ コンピュータからすべて実行」に変更し、「更新」をクリックすれば復旧できると思います。 なお、CDOが動かなくなった状態で、使用していた「Outlook」そのもののチェックを外してしまってもCDOは動かなくなったままになってしまうかもしれませんから注意して下さい。

CDOの利用は、Windows2000以降という限定はあるものの、追加コンポーネントのインストールが不要でマクロコードを書くだけでメール送信ができるようになるため便利だと考えられていましたが、このような問題があると逆に不便に見えてしまいます。 こんなことなら単純にコンポーネントだけを再起動せずにインストールできるBASP21」などを利用する方法の方が良いかもしれません。

では、上記のコードを実行時バインディングに書き換えてみましょう。
一番の問題は、「定数」です。参照設定を外してしまうと、これらの定数は未宣言になってしまうので、本モジュール内で宣言し直すか、値で直接扱うように書き換える必要があります。プロシージャをなるべく変更しない方向で進めるので、モジュールレベルに定数として宣言することにします。
さて、では、どのように宣言するのでしょうか。

    Const cdoSendUsingMethod = "HOGEHOGE"
この"HOGEHOGE"には実際の値を掴まなければなりません。

ここではイミディエイトウィンドウを使うことにします。この方法ではマクロを実行せずに値を参照できます。
イミディエイトウィンドウは、表示メニューから起動できます。
頭に「?」をつけて、定数の名前を入力するだけです。
イミディエイトウィンドウで定数値を調べる。
このようになり、Enterを押して、下に表示される値はなんとURLでした。
とにかく、全部の定数をモジュール内で宣言できるように調べてから、参照設定を外すようにします。

実行時バインディングの方法で変更したものが、こちらのコードです。

'*******************************************************************************
'   CDOでメールを送信する
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit
' CDO関連の定数
Const cdoSendUsingMethod = _
    "http://schemas.microsoft.com/cdo/configuration/sendusing"
Const cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
Const cdoSMTPServerPort = _
    "http://schemas.microsoft.com/cdo/configuration/smtpserverport"
Const cdoSMTPConnectionTimeout = _
    "http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout"
Const cdoSMTPAuthenticate = _
    "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate"
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
Const cdoLanguageCode = _
    "http://schemas.microsoft.com/cdo/configuration/languagecode"
' 以下は文字コード指定(一部)
Const cdoShift_JIS = "shift-jis"
Const cdoEUC_JP = "euc-jp"
Const cdoISO_2022_JP = "iso-2022-jp"
Const cdoUTF_7 = "utf-7"
Const cdoUTF_8 = "utf-8"

'*******************************************************************************
' メール送信テストプログラム(添付ファイルなし)
'*******************************************************************************
Sub TEST()
    Dim MailSmtpServer As String
    Dim MailFrom As String
    Dim MailTo As String
    Dim MailSubject As String
    Dim MailBody As String
    Dim strMSG As String

    ' 送信確認
    If MsgBox("メールを送信します。" & vbCr & _
        "SMTP,発信者,宛先等は正しいですか?", vbYesNo) <> vbYes Then Exit Sub
    MailSmtpServer = Cells(1, 2).Text   ' SMTPサーバ
    MailFrom = Cells(2, 2).Text         ' 発信者
    MailTo = Cells(3, 2).Text           ' 宛先
    MailSubject = Cells(4, 2).Text      ' 件名
    MailBody = Cells(5, 2).Text         ' 本文
    ' メール送信(CC,BCCはブランク)
    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody)
    ' 文字コードを任意に指定する場合は以下のようにします。
'    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody, "", cdoISO_2022_JP)
    If strMSG <> "OK" Then MsgBox Mid(strMSG, 3)
End Sub

'*******************************************************************************
' メール送信テストプログラム(添付ファイルあり)
'*******************************************************************************
Sub TEST2()
    Dim MailSmtpServer As String
    Dim MailFrom As String
    Dim MailTo As String
    Dim MailSubject As String
    Dim MailBody As String
    Dim MailAddFile As Variant
    Dim strMSG As String

    ' 添付ファイルの選択
    MailAddFile = Application.GetOpenFilename("全てのファイル (*.*),*.*",, _
        "添付ファイルを選択して下さい。",, True)
    ' 送信確認
    If MsgBox("メールを送信します。" & vbCr & _
        "SMTP,発信者,宛先等は正しいですか?", vbYesNo) <> vbYes Then Exit Sub
    MailSmtpServer = Cells(1, 2).Text   ' SMTPサーバ
    MailFrom = Cells(2, 2).Text         ' 発信者
    MailTo = Cells(3, 2).Text           ' 宛先
    MailSubject = Cells(4, 2).Text      ' 件名
    MailBody = Cells(5, 2).Text         ' 本文
    ' メール送信(CC,BCCはブランク)
    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody, MailAddFile)
    ' 文字コードを任意に指定する場合は以下のようにします。
'    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody, MailAddFile, cdoISO_2022_JP)
    If strMSG <> "OK" Then MsgBox Mid(strMSG, 3)
End Sub

'*******************************************************************************
' メール送信(CDO)   ※実行時バインディング
'*******************************************************************************
' [引数]
'  @MailSmtpServer : SMTPサーバ名(又はIPアドレス)
'  AMailFrom       : 送信元アドレス
'  BMailTo         : 宛先アドレス(複数の場合はカンマで区切る)
'  CMailCc         : CCアドレス(複数の場合はカンマで区切る)
'  DMailBcc        : BCCアドレス(複数の場合はカンマで区切る)
'  EMailSubject    : 件名
'  FMailBody       : 本文(改行はvbCrLf付加)
'  GMailAddFile    : 添付ファイル(複数の場合はカンマで区切るか配列渡し) ※Option
'  HMailCharacter  : 文字コード指定(デフォルトはShift-JIS)              ※Option
' [戻り値]
'  正常時:"OK", エラー時:"NG"+エラーメッセージ
'*******************************************************************************
Private 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                        ' Object型に変更
    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 = 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)

    Set objCDO = CreateObject("CDO.Message")
    With objCDO
        With .Configuration.Fields                          ' 設定項目
            .Item(cdoSendUsingMethod) = cdoSendUsingPort    ' 外部SMTP指定
            .Item(cdoSMTPServer) = MailSmtpServer           ' SMTPサーバ名
            .Item(cdoSMTPServerPort) = 25                   ' ポート
            .Item(cdoSMTPConnectionTimeout) = 60            ' タイムアウト
            .Item(cdoSMTPAuthenticate) = cdoAnonymous       ' 0
            .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

'-----------------------------<< End of Source >>-------------------------------
このように定数の宣言を行なって、プロシージャの方は赤太字でコメントを入れてあるデータ型の変更とCreateObjectの行の追加だけです。これで問題なく動作しました。

どんなエラーが出るのかと、SMTPサーバの名前を存在しないものに変えてみると、
エラーメッセージ
(この画像をクリックすると、実際にExcel上で動作確認ができます)
となります。エラーコードは参照設定にトライした最初の頃のエラーと同じですが、
参照設定と比べるとメッセージ内容がプアですね。

Excel97対策を入れています。
2006年3月5日の変更分より、Excel97でも動くように「代替関数」を入れています。
元々、CDO自体はWindows2000以降でしか動作しませんが、Windows2000以降であってもExcel(Office)が「97」の場合は「Replace関数」「Split関数」が使われているマクロは動作しません。
そこで、以下のような「代替関数」を条件付きコンパイルが掛かる状態でセットしてあります。

'-------------------------------------------------------------------------------
' ※以下はExcel2000以降では動作しません。Excel2000以降のみの運用では削除可能です。
#If Not VBA6 Then
'*******************************************************************************
'   Excel97用Replace代替関数(本家の「Replace関数」とは機能が異なります)
'*******************************************************************************
Private Function Replace(strInText As String, _
                         strFind As String, _
                         strReplace As String) As String
    Dim POS As Long, POS1 As Long, POS2 As Long, POS3 As Long, POSMAX As Long
    Dim strOutText As String, strChar As String
    Dim lenFind As Long

    POSMAX = Len(strInText)
    lenFind = Len(strFind)
    If ((POSMAX = 0) Or (lenFind = 0)) Then
        Replace = strInText
        Exit Function
    End If
    POS1 = 1
    Do Until POS2 > POSMAX
        ' Find文字の位置を検査
        POS2 = InStr(POS1, strInText, strFind, vbBinaryCompare)
        If POS2 = 0 Then
            ' 未発見時
            POS3 = POSMAX + 1
            strChar = ""
            POS2 = POS3
        Else
            ' 発見時
            POS3 = POS2
            strChar = strReplace
            POS2 = POS2 + lenFind
        End If
        ' 発見位置の前までを転記
        strOutText = strOutText & Mid(strInText, POS1, POS3 - POS1) & strChar
        POS1 = POS2
    Loop
    Replace = strOutText
End Function

'*******************************************************************************
'   Excel97用Split代替関数(本家の「Split関数」とは機能が異なります)
'*******************************************************************************
Private Function Split(strInText As String, _
                       strDelimiter As String) As Variant
    Dim POS As Long, POS1 As Long, POS2 As Long, POS3 As Long, POSMAX As Long
    Dim tblArray() As String, IX As Long
    Dim lenDelimiter As Long

    POSMAX = Len(strInText)
    lenDelimiter = Len(strDelimiter)
    If ((POSMAX = 0) Or (lenDelimiter = 0)) Then
        Split = Array(strInText)
        Exit Function
    End If
    IX = -1
    ReDim tblArray(0)
    POS1 = 1
    Do Until POS2 > POSMAX
        ' Find文字の位置を検査
        POS2 = InStr(POS1, strInText, strDelimiter, vbBinaryCompare)
        If POS2 = 0 Then
            ' 未発見時
            POS3 = POSMAX + 1
            POS2 = POS3
        Else
            ' 発見時
            POS3 = POS2
            POS2 = POS2 + lenDelimiter
        End If
        ' 発見位置の前までを配列にセット
        IX = IX + 1
        ReDim Preserve tblArray(IX)
        tblArray(IX) = Mid(strInText, POS1, POS3 - POS1)
        POS1 = POS2
    Loop
    Split = tblArray
End Function
#End If

'-----------------------------<< End of Source >>-------------------------------
このため、Windows2000が以降であれば、Excelは「97」でも動作できます。 また、動作環境がExcel2000以降に限定されているならば、この記述部分は削除しても構いません。

開封確認要求を付加させる方法
開封確認要求を付けることができます。
「開封確認」が相手のメールソフトに表示されたところ
(これはメールの受け取り側で開封確認要求が表示されたところです。)
この場合は、

        .Subject = MailSubject                  ' 件名
        .TextBody = MailBody                    ' 本文
これらが記述されているところに、

        .MDNRequested = True                    ' 開封確認要求
この1行を追加して下さい。参照設定版では「自動メンバ表示」の中に見つかるはずです。
但し、開封確認要求はメールソフトの設定によって確認表示を出さずに無視するようなこともできるため、確実な方法ではありません。

送信したメールが文字バケする場合の対処方法
受信するメールソフトの設定や使用環境によっては、上記コードのままでは文字バケになってしまう場合があるようです。
このサンプルでは、以前は、

    With objCDO
        With .Configuration.Fields                          ' 設定項目
            .Item(cdoLanguageCode) = cdoShift_JIS           ' 文字セット指定


        .TextBodyPart.Charset = cdoShift_JIS                ' 文字セット指定
というように「シフトJIS」に固定していたのですが、現在は引数から文字コードの指定が渡るようにしており、 引数から渡されない場合に「シフトJIS」になるようにしています。
「引数で渡す」部分はサンプルコードにコメントで、

    ' 文字コードを任意に指定する場合は以下のようにします。
'    strMSG = SendMailByCDO(MailSmtpServer, MailFrom, MailTo, "", "", _
        MailSubject, MailBody, "", cdoISO_2022_JP)
というように記述してありますから、通常の「SendMailByCDO」の方をコメントにして、 こちらを有効にしてみて下さい。
このサンプルで渡している「cdoISO_2022_JP」の部分はこの他に、

'        cdoBIG5         ' "big5"
'        cdoEUC_JP       ' "euc-jp"
'        cdoEUC_KR       ' "euc-kr"
'        cdoGB2312       ' "gb2312"
'        cdoISO_2022_JP  ' "iso-2022-jp"
'        cdoISO_2022_KR  ' "iso-2022-kr"
'        cdoISO_8859_1   ' "iso-8859-1"
'        cdoISO_8859_2   ' "iso-8859-2"
'        cdoISO_8859_3   ' "iso-8859-3"
'        cdoISO_8859_4   ' "iso-8859-4"
'        cdoISO_8859_5   ' "iso-8859-5"
'        cdoISO_8859_6   ' "iso-8859-6"
'        cdoISO_8859_7   ' "iso-8859-7"
'        cdoISO_8859_8   ' "iso-8859-8"
'        cdoISO_8859_9   ' "iso-8859-9"
'        cdoKOI8_R       ' "koi8-r"
'        cdoUS_ASCII     ' "us-ascii"
'        cdoUTF_7        ' "utf-7"
'        cdoUTF_8        ' "utf-8"
このコメント行のものがあるようですから、指定がはっきりしているなら変更させてみて下さい。実行時バインディングでは右端の文字列での定数宣言が必要になります。 外国語の場合は指定が分からないかも知れません。最後の手段は、このコメント行を全てソースコードに持ち込んで、順に試すなどで対応してみて下さい。
文字セットの指定は、この他、
のように記述する方法があることまではWeb検索で見つけたのですが、私は「文字バケ」に出会っていないので最良の方法を見つけるには至っていません。 こちらの方法ではExcelがダウンしたりする現象にも会っているのでお勧めはできませんが、「文字バケ」対策を探している方には情報として添えておきます。

HTMLメール」は送信できるのか
HTMLメール」は使っても良いのか? 企業や官公庁でHTMLメール」そのものを「禁止」としているところは多いようです。私が所属している会社も「禁止」です。 なぜ、禁止されるかというと、一般にメールソフトはブラウザに比べるとセキュリティ面が非常に弱い(弱かった?)からだと思います。
現在のメールソフトはほとんど「プレビュー」機能が搭載されていて、一覧から選択するだけでメールの内容がウィンドウ表示されます。 この状態で「HTMLメール」が表示されると記述してあるスクリプトも動作してしまうため、表示させただけでウィルスの感染に繋がってしまうというわけです。 添付ファイルならメールの本文を表示しただけでは感染しませんが、「HTMLメール」では表示だけでスクリプトまで動作するので、ブラウザ並みのセキュリティ機能がないとウィルスの感染の温床になりかねません。
最近ようやくセキュリティ面でのアップデートもなされましたが、その正否も不明な上、メールソフトは種類も多くさらにアップデートのバージョンの判定までというと実際面で管理しきれない事情があるので、そもそも「HTMLメール」自体を利用禁止にするということになるのでしょう。
フォントや文字色などを駆使できる「HTMLメール」を希望されている方も多いようです。 上のコラムに書いた通り、「HTMLメール」そのものの是非もあるのですが、物理的に可能なのかが確認できたので変更方法を説明しておきます。
上記の「SendMailByCDO」プロシージャ内に変更を行なう必要があります。変更箇所は、

        .TextBody = MailBody                    ' 本文
        .TextBodyPart.Charset = cdoShift_JIS    ' 文字セット指定
この2行で、以下のように変更します。(旧記述はコメントで残しました)

'        .TextBody = MailBody
        .HTMLBody = MailBody                    ' 本文
'        .TextBodyPart.Charset = cdoShift_JIS
        .HTMLBodyPart.Charset = cdoShift_JIS    ' 文字セット指定
と、これだけで良いようです。
後は、「SendMailByCDO」を呼び出す元プロシージャの方で、引数「MailBody」にセットする本文の編集で、 HTMLタグ等を組み込めば良いわけです。 ただ、この手のことを質問される方の中で、「HTMLメールにすればExcelシートを渡してそのまま表イメージになる」などと勘違いしている人もいるので 念のためですが、メールは「HTMLメール」であっても本文の正体は「テキスト」であって、メールソフトがHTMLタグ等をブラウザ同様に解釈して表示してくれるだけで、 マクロからメールを送信させる場合はそのためのHTMLタグの実装もコード中で行なう必要があるということです。

「重要度」の指定はできるのか
一般のメールソフトでは「重要度」の指定ができ、たとえば「高」を指定して送信すると、受信した側では一覧に赤いマークが付いたりします。 メールのヘッダー情報の取り扱いに詳しいわけではないので、手元にあるメールソフト(Becky2!)で表示されるかどうかで確認していったところ以下のようになりました。

「重要度」の指定を行なう場合は、上記の「SendMailByCDO」プロシージャ内に記述追加を行なう必要があります。追加記述は、

        .Fields.Update
のすぐ上に、

        ' 重要度「高」
        With .Fields
            .Item("urn:schemas:mailheader:x-priority").Value = 1
            .Item("urn:schemas:mailheader:x-msmail-priority").Value = "high"
        End With
を追加します。
「高」以外の「重要度」の指定は以下のようにして下さい。

        ' 重要度「やや高」
        With .Fields
            .Item("urn:schemas:mailheader:x-priority").Value = 2
            .Item("urn:schemas:mailheader:x-msmail-priority").Value = "high"
        End With

        ' 重要度「やや低」
        With .Fields
            .Item("urn:schemas:mailheader:x-priority").Value = 4
            .Item("urn:schemas:mailheader:x-msmail-priority").Value = "Low"
        End With

        ' 重要度「低」
        With .Fields
            .Item("urn:schemas:mailheader:x-priority").Value = 5
            .Item("urn:schemas:mailheader:x-msmail-priority").Value = "Low"
        End With
多数出回っているメールソフトの動作について、個別に確認できてはいないので、この点に興味がある方は試してみて下さい。

送信認証を行なうメールサーバでの対応
送信認証って?   インターネットメールの元々の原理は通常の郵便と同じで「誰でも投函できる」という仕組みです。 本来、ポストに郵便を投函するのに本人確認などはありません。 インターネットメールも受信についてはアカウント照合が行なわれますが、送信には認証はなかったのです。
しかし、この状態がスパムメールの温床になっているわけですから企業やプロバイダはこの対策として「送信認証」を取り入れようとしています。
さらにインターネットメールの送信サーバ前でメール情報を第三者が傍受することを避けるため暗号化も取り入れられています。
これらを採用している企業やプロバイダでCDOを使ってメールを送信する方法については、 そもそも対応が「できる」「できない」が判らなかったことや、記述自体も判らなかったことなので「できない」の方へ傾いていたのです。 「認証」についても「暗号化」についても方式が複数あるようで、仮にできたとしてもここで解説するにあたって「この方法ならOK」とも言えないのです。
私の契約プロバイダはこのホームページも置かせていただいているASAHIネット」さんで、もう15年以上のおつき合いです。 アナログダイアルアップ時代から、ISDNADSL、そして「ひかり」と接続方法は変遷していますが、プロバイダの契約先は変わっていません。 現在では「ひかり」もベストエフォートですが1Gbps接続になりました。 メールアドレスなどが換えられないこともありますが、常に安定していて高速であり費用が高いということもない最良のプロバイダだと思います。(乗り換え比較はしていません)
話が逸れましたが、このASAHIネット」さんも「暗号化+送信認証」に対応しており、 旧方式(非暗号化+非認証送信)は残っているようですが契約者には「暗号化+送信認証」でのメールソフトの設定を推奨しています。
ここでこの「暗号化+送信認証」でのCDOからのメール送信に成功したのでサンプルを提示することにします。 ASAHIネット」さんの方式は「SMTP over SSL/TSL」「APOP認証」と説明されています。 この辺の仕組みの方の解説はこれらを熟知しているわけではないので私には一切できません。設定の類推して試してみて送信できたというだけです。
要はメール送信するために利用するSMTPサーバの要求仕様に合わせてやるということですが、その環境の中でないと動作確認ができないのでこの他の方式については見解を示すことはできません。 ここでは私のところの環境で送信できるようになった中核になる部分のコードだけ提示しますので、この辺で悩んでいる方は参考にしてみて下さい。

■参照設定の場合

'*******************************************************************************
'   CDOでメールを送信する(SMTPS+APOP認証+Port465)   ※参照設定版
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
'   [参照設定]
'   ・Microsoft CDO for Windows 2000 Library
'     (or Microsoft CDO for Exchange 2000 Library)
'*******************************************************************************
Option Explicit
'-------------------------------------------------------------------------------
' メールサーバ環境情報
Private Const cnsMailServer = "mail.hogehoge.co.jp"         ' SMTPサーバ
Private Const cnsCharacterCode = "iso-2022-jp"              ' 文字セット
Private Const cnsPortNo = 465                               ' 送信ポート(※)
Private Const cnsTimeOut = 60                               ' タイムアウト
Private Const cnsAuthenticate = 1                           ' 認証有無(※)
Private Const cnsUseSSL = True                              ' SSL指定(※)
'-------------------------------------------------------------------------------
' 認証情報(契約者情報)
Private Const cnsAuthUserId = "hogehoge"                    ' ユーザーID(※)
Private Const cnsAuthPassword = "hogehoge"                  ' パスワード(※)
'-------------------------------------------------------------------------------
' 送信メール情報(テストなので差出人と宛先を同じにしてあります)
Private Const cnsMailFrom = "hogehoge@hogehoge.co.jp"       ' 差出人アドレス
Private Const cnsMailTo = "hogehoge@hogehoge.co.jp"         ' 宛先アドレス
Private Const cnsSubject = "てすと"                         ' 件名
Private Const cnsBody = "これはテストメールです。ポート465で送信しています。"

'*******************************************************************************
' メール送信(CDO)  ※参照設定版
'*******************************************************************************
Sub SendMailByCDO_SSL1()
    '---------------------------------------------------------------------------
    With New cdo.Message
        With .Configuration.Fields                          ' 設定項目
            .Item(cdoSendUsingMethod) = cdoSendUsingPort    ' 外部SMTP指定
            .Item(cdoSMTPServer) = cnsMailServer            ' SMTPサーバ名
            .Item(cdoSMTPServerPort) = cnsPortNo            ' ポート(※)
            .Item(cdoSMTPConnectionTimeout) = cnsTimeOut    ' タイムアウト
            .Item(cdoSMTPAuthenticate) = cnsAuthenticate    ' 認証あり(※)
            .Item(cdoLanguageCode) = cnsCharacterCode       ' 文字セット指定
            .Item(cdoSendUserName) = cnsAuthUserId          ' ユーザー(※)
            .Item(cdoSendPassword) = cnsAuthPassword        ' パスワード(※)
            .Item(cdoSMTPUseSSL) = cnsUseSSL                ' SSL指定(※)
            .Update                                         ' 設定を更新
        End With
        .MimeFormatted = True
        .Fields.Update
        .From = cnsMailFrom                                 ' 送信者
        .To = cnsMailTo                                     ' 宛先
        .Subject = cnsSubject                               ' 件名
        .TextBody = cnsBody                                 ' 本文
        .Send                                               ' 送信
    End With
End Sub

'-----------------------------<< End of Source >>-------------------------------

■実行時バインドの場合

'*******************************************************************************
'   CDOでメールを送信する(SMTPS+APOP認証+Port465)   ※実行時バインド版
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit
'-------------------------------------------------------------------------------
' 規定値(固定)
Private Const cnsConfiguration = "http://schemas.microsoft.com/cdo/configuration/"
Private Const cnsSendUsing = 2
'-------------------------------------------------------------------------------
' メールサーバ環境情報
Private Const cnsMailServer = "mail.hogehoge.co.jp"         ' SMTPサーバ
Private Const cnsCharacterCode = "iso-2022-jp"              ' 文字セット
Private Const cnsPortNo = 465                               ' 送信ポート(※)
Private Const cnsTimeOut = 60                               ' タイムアウト
Private Const cnsAuthenticate = 1                           ' 認証有無(※)
Private Const cnsUseSSL = True                              ' SSL指定(※)
'-------------------------------------------------------------------------------
' 認証情報(契約者情報)
Private Const cnsAuthUserId = "hogehoge"                    ' ユーザーID(※)
Private Const cnsAuthPassword = "hogehoge"                  ' パスワード(※)
'-------------------------------------------------------------------------------
' 送信メール情報(テストなので差出人と宛先を同じにしてあります)
Private Const cnsMailFrom = "hogehoge@hogehoge.co.jp"       ' 差出人アドレス
Private Const cnsMailTo = "hogehoge@hogehoge.co.jp"         ' 宛先アドレス
Private Const cnsSubject = "てすと"                         ' 件名
Private Const cnsBody = "これはテストメールです。ポート465で送信しています。"

'*******************************************************************************
' メール送信(CDO)  ※実行時バインド版
'*******************************************************************************
Sub SendMailByCDO_SSL2()
    '---------------------------------------------------------------------------
    ' 送信処理(SMTPS(SSL)+APOP認証+ポート465)
    With CreateObject("CDO.Message")
        With .Configuration.Fields                          ' 設定項目
            .Item(cnsConfiguration & "sendusing") = cnsSendUsing
            .Item(cnsConfiguration & "languagecode") = cnsCharacterCode
            .Item(cnsConfiguration & "smtpserver") = cnsMailServer
            .Item(cnsConfiguration & "smtpauthenticate") = cnsAuthenticate
            .Item(cnsConfiguration & "sendusername") = cnsAuthUserId
            .Item(cnsConfiguration & "sendpassword") = cnsAuthPassword
            .Item(cnsConfiguration & "smtpserverport") = cnsPortNo
            .Item(cnsConfiguration & "smtpusessl") = cnsUseSSL
            .Update
        End With
        .MimeFormatted = True
        .Fields.Update
        .From = cnsMailFrom                                 ' 送信者
        .To = cnsMailTo                                     ' 宛先
        .Subject = cnsSubject                               ' 件名
        .TextBody = cnsBody                                 ' 本文
        .Send                                               ' 送信
    End With
End Sub

'-----------------------------<< End of Source >>-------------------------------

最後に、添付ファイルの登録方法を説明しておきます。
添付ファイル付きメール送信のサンプルとして、サンプルプロシージャ「TEST2」を用意しています。これを見たり、動かしていただくと確認できますが、 メール送信本体のプロシージャ「SendMailByCDO」を呼び出す時に、本文の次に添付ファイルの引数が加わっていることがサンプルプロシージャ「TEST1」の呼び出し方との違いです。 添付ファイルはファイル名をフルパスで記述して引数にセットしますが、添付ファイルが複数個ある場合はカンマ区切りの文字列でも、配列でも引き渡すことができます。 添付ファイルの有無が不定な処理では、添付ファイルの引数はセットするものとし、この内容がEmptyNull、空文字列であれば添付ファイルがないものとして送信されるようになっています。
「ダウンロード」「メール送信(CDO利用)」を用意しました。  ここでの説明と異なるものではありませんが、送信の中核部分を別モジュール化して他用途への組み込みをしやすくしてあることと、一覧表からの連続送信の記述サンプルを追加してあります。 こちらと合わせて参考にしてみて下さい。
次のページに「メールフォームにPOSTする。」を用意しました。  このページで紹介しているCDOも、場合によっては動作しないことはご理解いただけたと思います。 では、できるだけ個々のクライアント環境に依存しないでメール送信を自動化できる方法はないだろうかと考えた時に、1つの方法としてこのサイトの「意見・質問」のようなメール送信フォームを利用できないかをやってみたものです。 今回は添付ファイルには対応していませんが、Windowsサーバ上のWebサービスであるIIS上で動作するサンプルを作ってみたので 関心がある方は覗いてみて下さい。