AliReza26 گفت:
'Dimension variables
Dim objCDOSYSCon
Dim intSendUsing
'Calculate the port we are sendusing (1=localhost 2=network)
If LCase(strOutgoingMailServer) = "localhost" OR strOutgoingMailServer = "http://127.0.0.1" OR strOutgoingMailServer = "127.0.0.1" Then
intSendUsing = 1
Else
intSendUsing = 2
End If
'Create the e-mail server object
Set objCDOSYSMail = Server.CreateObject("CDO.Message")
Set objCDOSYSCon = Server.CreateObject ("CDO.Configuration")
'Set and update fields properties
With objCDOSYSCon
' Specify the authentication mechanism to basic (clear-text) authentication cdoBasic = 1
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
'SMTP Server username
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "my username"
'SMTP Server password
.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") ="my password"
'Out going SMTP server
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = My OutgoingMailServer
'SMTP port
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'CDO Port (1=localhost 2=network)
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = intSendUsing
'Set CDO pickup directory if using localhost (CDO Port 1)
If intSendUsing = 1 Then
'CDO pickup directory (used for localhost service)
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverpickupdirectory") = "e:\pickup"
End If
'Timeout
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Fields("http://schemas.microsoft.com/cdo/configuration/languagecode") = "fa"
'Update CDO configuration
.Fields.Update
End With
'Update the CDOSYS Configuration
Set objCDOSYSMail.Configuration = objCDOSYSCon
With objCDOSYSMail
'Who the e-mail is from
.From = strFromEmailName
'Who the e-mail is sent to
.To = strRecipientName
'The subject of the e-mail
.Subject = strSubject
'Set the e-mail body format (HTMLBody=HTML TextBody=Plain)
If blnHTML = True Then
.HTMLBody = strEmailBodyMessage & strEmailBodyAppendMessage
Else
.TextBody = strEmailBodyMessage & strEmailBodyAppendMessage
End If
'Send the e-mail
If NOT strOutgoingMailServer = "" Then .Send
End with
'Close the server mail object
Set objCDOSYSMail = Nothing
mahdijalili گفت:
<meta http-equiv="Content-Language" content="fa">
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
Dim iMsg ' New CDO.message
Set iMsg = CreateObject("CDONTS.NewMail")
strHTMLBody = "<html>" & vbCrLf & "<head>" & vbCrLf
Select Case UCase(strLoggedLanguage)
Case "EL"
strHTMLBody = strHTMLBody & " <META http-equiv=Content-Type content=""text/html; charset=ISO-8859-7"">" & vbCrLf
Case "PL", "CS", "HU"
strHTMLBody = strHTMLBody & " <META http-equiv=Content-Type content=""text/html; charset=ISO-8859-2"">" & vbCrLf
Case "RU"
strHTMLBody = strHTMLBody & " <META http-equiv=Content-Type content=""text/html; charset=ISO-8859-5"">" & vbCrLf
Case Else
strHTMLBody = strHTMLBody & " <META http-equiv=Content-Type content=""text/html; charset=ISO-8859-1"">" & vbCrLf
End Select
strHTMLBody = strHTMLBody & _
" <title>" & strSubject & "</title>" & vbCrLf & _
"</head>" & vbCrLf & _
"<body>" & vbCrLf & _
"<pre>" & vbCrLf & _
"<font face=arial size=2>" & vbCrLf & _
"<b>" & vbCrLf & _
"</font>" & vbCrLf & _
"</pre>" & vbCrLf & _
"</body>" & vbCrLf & _
"</html>" & vbCrLf
With iMsg
.To = strEmailAddress
.From = """CDS Dealer Feedback"" <" & conFromEmailAddress & ">"
.Subject = strEmailSubject & ": " & strSubject
.Body = strHTMLBody
.MailFormat = 0
.BodyFormat = 0
End With
iMsg.Send
Set iMsg = Nothing
