CDOSYS を使用してクラシック ASP で電子メール送信コードを作成していますが、CDOSYS パラメータを使用して変数連結を記述しようとすると、エラーが発生します。
次の方法でコードを書くことができませんでした-
mail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "admin@" & website
実行中に次のエラーが表示されます - CDO.Message.1 エラー '80040213'
次のコードは、単一の変数を持つため、正常に機能します-
http://schemas.microsoft.com/cdo/configuration/sendusername") = websiteemail
注:- 私のクライアントには多くのサイトがあり、以前は CDONTS と ASPEMAILS を使用していましたが、以前は正常に機能していたため、そのように使用する理由です。
作成した関数は次のとおりです。
function email(s_from,s_reply_to,s_recipients,s_bcc,s_subject,s_msg,s_type,s_msg_error_add,s_remote_host)
if (s_msg_error_add<>"") then s_msg_error_add = "<hr>" & vbCrLf & s_msg_error_add
if (s_remote_host="default") then s_remote_host = application("s_mail_server")
if (s_remote_host="") then s_remote_host = "localhost"
s_remote_host=lcase(s_remote_host)
's_recipients looks like "Scott <scott@domain.net>; Sue <andy@domain.net>" etc
s_from = replace(s_from,","," ",1,-1,1)
s_from = replace(s_from," "," ",1,-1,1)
s_from = replace(s_from,"[","<",1,-1,1)
s_from = replace(s_from,"]",">",1,-1,1)
if (s_reply_to<>"") then
s_reply_to = replace(s_reply_to,","," ",1,-1,1)
s_reply_to = replace(s_reply_to," "," ",1,-1,1)
s_reply_to = replace(s_reply_to,"[","<",1,-1,1)
s_reply_to = replace(s_reply_to,"]",">",1,-1,1)
end if
s_recipients = replace(s_recipients,",",";",1,-1,1)
s_recipients = replace(s_recipients," "," ",1,-1,1)
s_recipients = replace(s_recipients,"[","<",1,-1,1)
s_recipients = replace(s_recipients,"]",">",1,-1,1)
if (s_bcc<>"") then
s_bcc = replace(s_bcc,","," ",1,-1,1)
s_bcc = replace(s_bcc," "," ",1,-1,1)
s_bcc = replace(s_bcc,"[","<",1,-1,1)
s_bcc = replace(s_bcc,"]",">",1,-1,1)
end if
err.clear
Dim MailerConfig
Dim Mailer
Dim strRet
dim sch
strRet = ""
sch = "http://schemas.microsoft.com/cdo/configuration/"
Set MailerConfig = CreateObject("CDO.Configuration")
Set Mailer = CreateObject("CDO.Message")
With MailerConfig.Fields
'.Item(sch & "sendusing") = 2 'send using port - if err then this is really "SendUsingMethod"
'.Item(sch & "sendusingmethod") = 2 'send using port - if err then this is really "SendUsingMethod"
.Item(sch & "smtpconnectiontimeout") = 900
'.Item(sch & "smtpauthenticate") = 1 'use basic (clear-text) authentication
.Item(sch & "smtpserver") = s_remote_host
'.Item(sch & "smtpserverport") = 25
'.Item(sch & "sendusername") = SMAUTHUSER
'.Item(sch & "sendpassword") = SMAUTHPASS
.Update
End With
Mailer.Configuration = MailerConfig
'Mailer.Fields(cdoImportance) = 1
'Mailer.Fields("urn:schemas:mailheader:X-MSMail-Priority") = 1
'Mailer.Fields("urn:schemas:mailheader:X-Mailer") = ""
'Mailer.Fields.Update
'-- Set the Mail Properties
'on error resume next
Mailer.From = s_from
Mailer.To = s_recipients
if (s_reply_to<>"" and s_reply_to<>"na") then Mailer.ReplyTo = s_reply_to
b_redirect=false
if (err.number<>0 and err.number<>13) then
session("msg") = "Error in i_fn_email_cdo.asp line 72, Error: " & err.number & "<br>" & err.description
if (b_redirect) then response.redirect ("error_report.asp?send_mail=yes")
end if
if (s_bcc<>"" AND s_bcc<>"na" AND s_bcc<>"n/a") then Mailer.BCC = s_bcc
if (err.number<>0 and err.number<>13) then
session("msg") = "Error in i_fn_email_cdo.asp line 79, Error: " & err.number & "<br>" & err.description
if (b_redirect) then response.redirect ("error_report.asp?send_mail=yes")
end if
Mailer.Subject = s_subject
if (err.number<>0 and err.number<>13) then
session("msg") = "Error in i_fn_email_cdo.asp line 86, Error: " & err.number & "<br>" & err.description
if (b_redirect) then response.redirect ("error_report.asp?send_mail=yes")
end if
if (s_type="html") then
Mailer.AutoGenerateTextBody = True
s_msg = replace(s_msg,vbCrLf,"<br>",1,-1,1)
else
Mailer.AutoGenerateTextBody = False
end if
if (err.number<>0 and err.number<>13) then
session("msg") = "Error in i_fn_email_cdo.asp line 103, Error: " & err.number & "<br>" & err.description
if (b_redirect) then response.redirect ("error_report.asp?send_mail=yes")
end if
Mailer.MimeFormatted = False
if (err.number<>0 and err.number<>13) then
session("msg") = "Error in i_fn_email_cdo.asp line 110, Error: " & err.number & "<br>" & err.description
if (b_redirect) then response.redirect ("error_report.asp?send_mail=yes")
end if
if (s_type = "text") then
Mailer.TextBody = fn_dirty(s_msg)
else
's_msg_html = replace(s_msg,vbCrLf,"<br>",1,-1,1)
s_msg_html = s_msg
Mailer.HTMLBody = fn_dirty(s_msg_html)
end if
if (err.number<>0 and err.number<>13) then
session("msg") = "Error in i_fn_email_cdo.asp line 123, Error: " & err.number & "<br>" & err.description
if (b_redirect) then response.redirect ("error_report.asp?send_mail=yes")
end if
'-- Fire off the email message
Mailer.Send
if (err.number<>0 and err.number<>13) then
Select Case err.Number
Case -2147220973
strRet = " Failure to Send Report Message - Server Not Found" & vbCrLf & " Error: " & err.Number & " - " & err.Description
Case -2147220975
strRet = " Failure to Send Report Message - Server Authentication Failed" & vbCrLf & " Error: " & err.Number & " - " & err.Description
Case Else
strRet = " Failure to Send Report Message - Error: " & err.Number & " - " & err.Description
End Select
msg = "<br>Error in i_fn_email_cdo.asp: " & strRet & "<br><br>"
msg = msg & "remote host = " & s_remote_host & "<br>"
s_from = replace(s_from,"<","[",1,-1,1)
s_from = replace(s_from,">","]",1,-1,1)
s_reply_to = replace(s_reply_to,"<","]",1,-1,1)
s_reply_to = replace(s_reply_to,">","[",1,-1,1)
s_recipients = replace(s_recipients,"<","[",1,-1,1)
s_recipients = replace(s_recipients,">","]",1,-1,1)
s_bcc = replace(s_bcc,"<","[",1,-1,1)
s_bcc = replace(s_bcc,">","]",1,-1,1)
msg = msg & "from = " & s_from & "<br>"
msg = msg & "to = " & s_recipients & "<br>"
msg = msg & "subject = " & s_subject & "<br>"
msg = msg & "recipients = " & s_recipients & "<br><br>"
if (s_type = "text") then
msg = msg & s_msg
else
msg = msg & s_msg_html
end if
msg = msg & "<br>"
msg = msg & s_msg_error_add
session("msg") = msg
Set Mailer = Nothing
set MailerConfig = nothing
if (b_redirect) then response.redirect ("error_report.asp?send_mail=yes")
end if
Set Mailer = Nothing
set MailerConfig = nothing
email = true
end function