eMailMe (CDO)

Single asp file (having function) to send an email
It is used here to send an email from guest to admin requesting subscription to newsletter.
Has option to attach a file (or an image to be included inside the email body)
Has lots of potential of growing

CodeFunctionName
What is this?

Public

Tested

Original Work
<%
EmailAddress = Request.QueryString("e") ' subscriber email address
RedirectThen = Request.QueryString("r") ' redirect to page after sending email

eMailServer = "email.server.com"
eMailAccount = "email@address.com"
eMailPwd = "email account password"

if UCase(Replace(EmailAddress, "%40", "@")) < > "YOUR@EMAIL.COM" Then
HTMLBod = "Email request processed through 7Bricks.com <br/ > <br/ >eMail: " & EmailAddress
SendMail eMailAccount, eMailAccount,"" ,"7Bricks email submit", HTMLBod, ""
End if
Response.Redirect RedirectThen ' "http://7Bricks.com"


Sub SendMail(sFrom, sTo, sCC, sSubject, sBody, Add_Image)
Const MailPort = 25
Const MailUsing = 2
Const MailBasic = 1 'basic (clear-text) authentication

Set mymail = CreateObject("CDO.Message")
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = MailUsing
'Name or IP of remote SMTP server
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = eMailServer
'Server port
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = MailPort
'Type of authentication, NONE, Basic (Base64 encoded), NTLM
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = MailBasic
'Your UserID on the SMTP server
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = eMailAccount
'Your password on the SMTP server
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = eMailPwd
'Server port (typically 25)
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'Use SSL for the connection (False or True)
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False
'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
mymail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
mymail.Configuration.Fields.Update

If Add_Image > "" Then
' Set RBP = mymail.AddRelatedBodyPart(FixPath() & "EmailBody_GITSD.png", "EmailBody_GITSD.png", 1)
' RBP.Fields.Item("urn:schemas:mailheader:Content-ID") = " <EmailBody_GITSD.png >"
Set RBP = mymail.AddRelatedBodyPart(Add_Image, Add_Image, 1)
RBP.Fields.Item("urn:schemas:mailheader:Content-ID") = " <" & Add_Image & " >"
RBP.Fields.Update
End If

mymail.Subject = sSubject
mymail.From = sFrom
mymail.To = sTo
mymail.cc = sCC
mymail.BodyPart.Charset = "utf-8"
mymail.HTMLBody = sBody
mymail.HTMLBodyPart.Charset = "windows-1256"
mymail.HTMLBodyPart.ContentTransferEncoding = "binary"
On Error Resume Next
mymail.send
If Err.Number < > 0 Then
' MsgBox "Error sending" & vbCrLf & Err.Number & " : " & Err.Description, vbCritical
Else
'MsgBox " Sent ok", vbInformation
End If
Set mymail = Nothing
End Sub

% >

sFrom, sTo, sCC, sSubject, sBody, Add_Image

Views 2,126

Downloads 777

CodeID
DB ID