MSが提唱しているCDOを使ってメールの送信を行なってみます。

「CDO」とは、何でしょう。

本サイトでは、VBAで外部コンポーネントによるメール送受信ができることを以前からお伝えしていました。これについては何も変わりはありませんが、Windows2000の登場と合わせてCDOというものが登場してきました。MSの説明では「Microsoft Collaboration Data Objects」の略で「メッセージング アプリケーションやコラボレーション アプリケーションを構築するためのテクノロジーです。」ということです。
まあ、これでは何だか解らないし、別に他の方法で目的が実現できていればそれでよかったこともありますが、Windows2000の登場から約５年もたった現在に至って取り上げてみようと思います。

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

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

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

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

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

ソースコードです。 実際の送信部分は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でした。この記述にしてからはどちらもＯＫとなり、Windows2000SP4とWindowsXP(Pro)SP2で動作しています。
Windows自体のパッチやサービスパックで動作が変わる可能性があります。私見ですが、安定性では外部コンポーネントに一日に長があるように思えます。

参照設定は以下のように行ないます。

「Microsoft CDO for Windows 2000 Library」を参照設定しますが、FieldsオブジェクトはADOのメンバだと説明されているので、一応、「Microsoft ActiveX Data Objects 2.x Library」も参照設定に加えておきました。
この状態で、Windows2000SP4とWindowsXP(Pro)SP2で問題なく動作しています。

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


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

Office2003のインストールでCDOが動かなくなる！

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

すると、この「Microsoft Office 2003 セットアップ」が起動します。ここでは「機能の追加／削除」を選びます。


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


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


すると、「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                    ' 開封確認要求

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

送信したメールが文字バケする場合の対処方法

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

    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    ' 文字セット指定

この２行で、以下のように変更します。（旧記述はコメントで残しました）

'        .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

多数出回っているメールソフトの動作について、個別に確認できてはいないので、この点に興味がある方は試してみて下さい。

最後に、添付ファイルの登録方法を説明しておきます。

添付ファイル付きメール送信のサンプルとして、サンプルプロシージャ「TEST2」を用意しています。これを見たり、動かしていただくと確認できますが、 メール送信本体のプロシージャ「SendMailByCDO」を呼び出す時に、本文の次に添付ファイルの引数が加わっていることがサンプルプロシージャ「TEST1」の呼び出し方との違いです。 添付ファイルはファイル名をフルパスで記述して引数にセットしますが、添付ファイルが複数個ある場合はカンマ区切りの文字列でも、配列でも引き渡すことができます。 添付ファイルの有無が不定な処理では、添付ファイルの引数はセットするものとし、この内容がEmpty、Null、空文字列であれば添付ファイルがないものとして送信されるようになっています。