メールフォームにPOSTする。

Webのメール送信フォームを利用するようなサンプルです。
WebサーバはIISをサンプルにしていますが...   ここでの説明は、クライアントのコンポーネントなどを利用してメールを送信するのではなく、既存のWebサーバに置かれたメール送信ページにVBAからフォームデータをPOST送信させようとするものです。 WebサーバはWindowsIISをサンプルにしていますが、 これに限定されるものではなく、CGIなどで作成されるものでも構いません。 要は、メール送信フォームの部分をVBAが担当するのです。
なお、前ページと同様ですが、送信認証を要求するSMTPサーバには対応していません。
これは昨今のセキュリティソフトの対策でもあります。   ※昨今のセキュリティソフトは機能が強化されていて、プログラムから確認なくメールが送信されるのをブロックしてくるケースが増えています。 これはこれでセキュリティ上の機能として必要な場合があるわけですが、逆効果として社内で認知されているプログラムからのメール送信までもブロックされてしまうという結果になります。 個々のクライアントについて、セキュリティソフトの設定を変更して当該プログラムのメール送信をブロックから除外させることはできると思いますが、 確実に設定変更されているという「保証」が取れないことになります。このページで説明している方法は、メールの送信をクライアントから行なうのではなく、WebサーバのページにPOSTさせて、POSTされたフォームを受け取ったページが送信動作を行ないます。従って、クライアントの設定には影響されにくいという利点があるわけです。
まず、簡単なメール送信フォームを作成してみます。
メール送信フォームは、実際にメールの件名や本文などを入力するフォームページと、そのフォームをPOSTする先の実際の送信ページの2つで構成されます。 最終的には「メールの件名や本文などを入力するフォームページ」の部分をVBAが担当するのでこちらは不要になりますが、 まずは、単純に「実際の送信ページ」が機能するのかを確認しておきます。

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<html lang="ja">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=shift_jis">
<title>メール送信テスト(MailTest.html) ※CC,BCCは無視</title>
</head>
<body>
<form name="MailTest" method="POST" action="MailSend.asp">
  発信者<input size="60" type="text" name="TXT_FROM"><br>
  宛 先<input size="60" type="text" name="TXT_TO"><br>
  件 名<input size="60" type="text" name="TXT_SUBJ"><br>
  本 文<input size="60" type="text" name="TXT_BODY"><br>
  <input type="submit" value="送信">
</form></body></html>
何の装飾もない「メール送信フォーム」です。こちらの拡張子はASPでもHTMLでも構いません。 最終的には、このページのフォーム送信部分をVBAのコードで行なうので、運用上ではこのフォームページは不要になります。
なお、このサンプルでは、CCBCCは省略しています。

次は、上の「メール送信フォーム」のPOST先である「MailSend.asp」です。

<%@ Language="VBScript" %>
<%
'*******************************************************************************
'*  メール送信ページ(IIS/ASP)      MailSend.asp
'*******************************************************************************
Option Explicit
' ↓SMTPサーバのIPアドレスかSMTPサーバ名を記述して下さい。
Const cnsSMTPServer = "xxx.xxx.xxx.xxx"
' 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"
Dim objCDO, strERROR, strFrom, strTo, strSubject, strBody, strCc, strBcc
On Error Resume Next
' フォームから送信情報を受け取る
strFrom = "" & Trim(Request.Form("TXT_FROM"))     ' 送信者
strTo = "" & Trim(Request.Form("TXT_TO"))         ' 宛先
strCc = "" & Trim(Request.Form("TXT_CC"))         ' CC
strBcc = "" & Trim(Request.Form("TXT_BCC"))       ' BCC
strSubject = "" & Trim(Request.Form("TXT_SUBJ"))  ' 件名
strBody = "" & Trim(Request.Form("TXT_BODY"))     ' 本文
strERROR = ""
' コンポーネント(CDOSYS.dll)を呼び出す
Set objCDO = Server.CreateObject("CDO.Message")
With objCDO
    With .Configuration.Fields                    ' 設定項目
        .Item(cdoSendUsingMethod) = 2             ' 外部SMTP指定
        .Item(cdoSMTPServer) = cnsSMTPServer      ' SMTPサーバ名
        .Item(cdoSMTPServerPort) = 25             ' ポート
        .Update                                   ' 設定を更新
    End With
    .From = strFrom                               ' 送信者
    .To = strTo                                   ' 宛先
    If strCc <> "" Then .CC = strCc               ' CC
    If strBcc <> "" Then .BCC = strBcc            ' BCC
    .Subject = strSubject                         ' 件名
    .TextBody = strBody                           ' 本文
    .Send                                         ' 送信
End With
Set objCDO = Nothing
If Err.Number <> 0 Then
    strERROR = Err.Description
Else
    strERROR = "OK"
End If
Response.Write strERROR
%>
こちらはASPで作成した例です。 実際には、自サーバからメールを送信するわけではなく、社内で認められているメールサーバに送信を依頼する一般のメールソフトと同様な動作になっています。 一般的なプロバイダのWebサービスなどであれば、この機能のCGIが提供されていたりするので、それを利用するように考えても良いと思います。 今回は、このようにサーバサイドスクリプトだけのASPを作成してWebサーバ側でメール送信を行ないます。 前ページから説明していますが、送信自体はここでもCDOを利用してSMTPサーバに引き渡しています。 この時のCDOはクライアントに実装するものではなく、Webサーバに実装されたものから送信されるので、 クライアント個々の状態に影響されずにメール送信ができるだろうというのが今回の目的です。
この中の、

' ↓SMTPサーバのIPアドレスかSMTPサーバ名を記述して下さい。
Const cnsSMTPServer = "xxx.xxx.xxx.xxx"
この定数値の部分だけは、実際の環境に合わせて変更する必要があります。

この2つのページが出来たら、Webサーバ上の同じフォルダに置いて、ブラウザから上記の「メール送信フォーム」の方を呼び出して送信テストを行なって下さい。 発信者、宛先を自分自身にしておいて送信を行なってみてから、自分のメールソフトで受信してみるという方法で確認できると思います。
メール送信フォーム
(この画像をクリックすると、実際にWebページとExcelブックを収容した圧縮ファイルがダウンロードできます。)

送信時には、ブラウザの方に「OK」またはエラーメッセージが表示されるようになっています。
メール送信フォーム
VBAでの実行時には、このメッセージはVBAが受け取ります。

では、マクロ(ExcelVBA)でやってみましょう。
上記での送信テストが問題ないようであれば、ExcelVBAで試してみましょう。
メール送信テストブック
実際に運用面で想定されるのは、作成した仕組みを運用する上での障害通報などユーザーが任意に「送信」を意識することのない機能だと思うので、このようなワークシートを作成することはないと思います。 ここでは、あくまで説明用あるいはテスト用として動かしてみるものです。
画面の説明は不要だと思いますので、マクロのソースコードを見てみることにしてみます。

'*******************************************************************************
'   メール送信機能サンプル              ※ASPページ呼び出し
'
'   作成者:井上治  URL:http://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'*******************************************************************************
Option Explicit
' 送信ページの指定(実際の環境に合わせて変更して下さい)
Const g_cnsMailUrl As String = "http://localhost/MailSend.asp"

'*******************************************************************************
'   メール送信(ASPページ呼び出し)
'*******************************************************************************
Public Sub SendMail_for_ASP()
    Dim GYO As Long, GYOEND As Long
    Dim strMessage As String, strRes As String, strBody As String

    '---------------------------------------------------------------------------
    ' POSTメッセージの編集(URLエンコードは外部関数化)
    strMessage = "TXT_FROM=" & FP_Encode_URL(Cells(1, 2).Value) & _
        "&TXT_TO=" & FP_Encode_URL(Cells(2, 2).Value)
    If Cells(3, 2).Value <> "" Then
        strMessage = strMessage & "&TXT_CC=" & FP_Encode_URL(Cells(3, 2).Value)
    End If
    If Cells(4, 2).Value <> "" Then
        strMessage = strMessage & "&TXT_BCC=" & FP_Encode_URL(Cells(4, 2).Value)
    End If
    strBody = Cells(6, 2).Value
    GYO = 7
    GYOEND = Cells(26, 2).End(xlUp).Row
    Do While GYO <= GYOEND
        strBody = strBody & vbCrLf & Cells(GYO, 2).Value
        GYO = GYO + 1
    Loop
    strMessage = strMessage & "&TXT_SUBJ=" & FP_Encode_URL(Cells(5, 2).Value) & _
        "&TXT_BODY=" & FP_Encode_URL(strBody)
    '---------------------------------------------------------------------------
    ' POST送信(MSXML2の実行時バインド)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", g_cnsMailUrl, False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send (strMessage)
        strRes = .ResponseText
    End With
    If Trim(strRes) <> "" Then MsgBox strRes
End Sub

'*******************************************************************************
'   URLエンコード処理(BASP21利用)
'*******************************************************************************
Public Function FP_Encode_URL(ByRef strSource As String) As String
    Static objBASP21 As Object
    If objBASP21 Is Nothing Then
        Set objBASP21 = CreateObject("BASP21")
    End If
    FP_Encode_URL = objBASP21.Base64(strSource, 4)
End Function

'--------------------------------<< End of Source >>----------------------------
フォームを取り扱うために「URLエンコード」という処理が入るのですが、発信者・宛先から件名・本文までを全て1つのPOSTメッセージとして編集してしまえば、実際の送信部分は、

    ' POST送信(MSXML2の実行時バインド)
    With CreateObject("MSXML2.XMLHTTP")
        .Open "POST", g_cnsMailUrl, False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .Send (strMessage)
        strRes = .ResponseText
    End With
これだけに集約されています。
GET送信であれば「URLエンコード」は不要なのですが、禁則文字の処理などが必要になるためここではPOST送信が良いだろうと判断しています。
このサンプルコードでは中核部分にフォーカスを当てるため「URLエンコード」に外部コンポーネントである「BASP21」の搭載関数である「Base64」を利用していますが、 このままでは結局「BASP21」のインストールが前提条件になってしまいます。

実際の「URLエンコード」は全角文字やHTMLタグなどの認識文字などを「"%"+16進コード表意文字」に置き換えるということのようで(HTMLを扱っているわりにはよく解っていない)、 いろいろ検索して調べてみると、下記のような関数を作成すれば良いようです。

'*******************************************************************************
'   URLエンコード処理
'*******************************************************************************
Private Function FP_Encode_URL(ByRef strSource As String) As String
    Const cnsPer = "%"
    Const cnsZero = "0"
    Dim lngLenB As Long, cntRead As Long
    Dim bytChar As Byte, bytTbl() As Byte
    Dim strBuf As String

    FP_Encode_URL = ""
    lngLenB = LenB(StrConv(strSource, vbFromUnicode))
    ' ブランクの場合は終了
    If lngLenB < 1 Then Exit Function
    '---------------------------------------------------------------------------
    ' 入力文字列をバイト配列に格納
    ReDim bytTbl(lngLenB - 1)
    bytTbl = StrConv(strSource, vbFromUnicode)
    '---------------------------------------------------------------------------
    ' 文字列全体を繰り返す
    Do While cntRead < lngLenB
        ' 配列から1Byte取り出す
        bytChar = bytTbl(cntRead)
        ' 出力文字列を編集
        If (((bytChar >= &H81) And (bytChar <= &H9F)) Or _
            ((bytChar >= &HE0) And (bytChar <= &HEF))) Then
            ' 2バイト文字の1バイト目の処理
            GoSub Encode_URL_SUB
            cntRead = cntRead + 1
            ' 後半バイトがない場合は終了
            If cntRead >= lngLenB Then Exit Do
            ' 2バイト文字の2バイト目の処理
            bytChar = bytTbl(cntRead)
            GoSub Encode_URL_SUB
        ElseIf bytChar = &H20 Then
            ' 半角空白文字
            strBuf = strBuf & "+"
        ElseIf (((bytChar >= &H40) And (bytChar <= &H5A)) Or _
                ((bytChar >= &H61) And (bytChar <= &H7A)) Or _
                ((bytChar >= &H30) And (bytChar <= &H39)) Or _
                (bytChar = &H2A) Or (bytChar = &H2D) Or _
                (bytChar = &H2E) Or (bytChar = &H5F)) Then
            ' 変換不要文字(文字コードを戻す)
            strBuf = strBuf & Chr(bytChar)
        Else
            ' その他(変換出力)
            GoSub Encode_URL_SUB
        End If
        cntRead = cntRead + 1
    Loop
    ' 変換結果を返す
    FP_Encode_URL = strBuf
    Exit Function

'===============================================================================
' 出力編集共通処理(Hex値出力)
Encode_URL_SUB:
    strBuf = strBuf & cnsPer & Right(cnsZero & Hex(bytChar), 2)
    Return

End Function

'--------------------------------<< End of Source >>----------------------------
この関数の記述は調べた結果を元に作成していますが、Web上の動作などは得意な分野ではなく、動作原理を時間を掛けて調べているわけでもありません。 でも、このあたりはサンプルコードなどを含めてもWeb検索で多数ヒットする「一般的」なものだと思います。