EMaile 送信エラー対応
[ JCLEmu | 1NMATCH | MNMatch | ListEdit | ListEdit3 | Sort | Summary | Break | Report | Asasikomi | EMaile | 機能一覧 | BlockSort | 図形ファインド | 複合検索 | 2007 | リンク集 | 掲示板 ]

[t11]Eメール送信、送信エラー対応 
   V1.1以降は、入力可能項目となる為、対応不要となります。 2010/2/25

適用:「ポート25以外使用時」、「認証が必要な場合」
    現在は、ポート=25、認証=0(不要)、ユーザー名・パスワード無し、となっている。

対応:VBAを下記の様に修正する。
    標準モジュールの中の「Module1メール送信」の中にあります。
    赤字の部分を利用者の環境に合わせた値に変えて下さい。

'*******************************************************************************
' メール送信(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
' 指定なしの場合は+O166Shift-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) = 587 '25 'ポート
' --- 変更 ここまで
.Item(cdoSMTPConnectionTimeout) = 60 'タイムアウト
.Item(cdoSMTPAuthenticate) = cdoAnonymous '0
.Item(cdoLanguageCode) = strCharacter '文字セット指定
' --- 追加 ここから
.Item(cdoSMTPAuthenticate) = cdoBasic '=1
.Item(cdoSendUserName) = "aaaaa_bbbbb" 'sUserName 'SMTPサーバ:認証用ユーザ名
.Item(cdoSendPassword) = "*******" 'sPassWord 'SMTPサーバ:認証用パスワード
' --- 追加 ここまで
.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
'??? test
.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


[ JCLEmu | 1NMATCH | MNMatch | ListEdit | ListEdit3 | Sort | Summary | Break | Report | Asasikomi | EMaile | 機能一覧 | BlockSort | 図形ファインド | 複合検索 | 2007 | リンク集 | 掲示板 ]