How to use multiple variables directly with CDOSYS parameters in Classic ASP - email

I am writing email sending code in Classic ASP using CDOSYS, but what i found when i try to write variables concatenation with CDOSYS parameters its gives me error.
I could not write code in following way-
mail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = "admin#" & website
it givees me following error while execution - CDO.Message.1 error '80040213'
while following code works fine as its having single variable-
http://schemas.microsoft.com/cdo/configuration/sendusername") = websiteemail
Note:- Reason to use in that way because my client having many sites and previously we used CDONTS and ASPEMAILS and it used to work fine.

Here is the function I created:
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

Related

MS Access running SQL Stored Procedure Write Issue

I have managed to build a Access VBA query that runs a SQL Stored Procedure with parameters and seems to run and complete without incidence, however it does not write the data into the SQL Database. Am I missing a curtail part of coding?
The data is gathered from a form.
Function AddStaff()
Dim adoCN As New ADODB.Connection
Dim sConnString As String
Dim cmdObjCMD As New ADODB.Command
Dim BrandDataTxt
Dim StaffNameDataTxt
Dim NTloginIDDataTxt
Dim NMCUsernameDataTxt
Dim StaffAuditLevelDataTxt
Dim EmailAddressDataTxt
Dim PhoneLoginDataTxt
Dim TeamNameDataTxt
Dim TeamSegmentDataTxt
Dim StartDateDataTxt
Dim JobTitleDataTxt
DoCmd.OpenForm "AddNewStaff"
Forms!AddNewStaff.TBoxBrand.Value = BrandDataTxt
Forms!AddNewStaff.TBoxStaffName.Value = StaffNameDataTxt
Forms!AddNewStaff.TBoxPCLoginID.Value = NTloginIDDataTxt
Forms!AddNewStaff.TBoxNMCUsername.Value = NMCUsernameDataTxt
Forms!AddNewStaff.TBoxStaffAuditLevel.Value = CVar(StaffAuditLevelDataTxt)
Forms!AddNewStaff.TBoxEmailAddress.Value = EmailAddressDataTxt
Forms!AddNewStaff.TBoxPhoneLogin.Value = PhoneLoginDataTxt
Forms!AddNewStaff.TBoxTeamName.Value = TeamNameDataTxt
Forms!AddNewStaff.TBoxTeamSegment.Value = TeamSegmentDataTxt
Forms!AddNewStaff.TBoxStartDate.Value = CDate(StartDateDataTxt)
Forms!AddNewStaff.TBoxJobTitle.Value = JobTitleDataTxt
Set adoCN = New ADODB.Connection
sConnString = "Provider = SQLOLEDB; " & _
"Data Source = KCOMSQL26; " & _
"Initial Catalog = EclipseDW; " & _
"User ID = EclipseDW; " & _
"Password = M1Reporting; " & _
"Trusted_Connection = Yes; "
adoCN.Open sConnString
With cmdObjCMD
.ActiveConnection = sConnString
.CommandType = adCmdStoredProc
.CommandTimeout = 180
.CommandText = "Staff.usp_AddNewStaffMember"
.NamedParameters = True
.Parameters("#Brand") = " '" & BrandDataTxt & "'"
.Parameters("#StaffPrefName") = " '" & StaffNameDataTxt & "'"
.Parameters("#NTLoginID") = " '" & NTloginIDDataTxt & "'"
.Parameters("#NMCUsername") = " '" & NMCUsernameDataTxt & "'"
.Parameters("#StaffAuditLevel") = " " & StaffAuditLevelDataTxt & ""
.Parameters("#EmailAddress") = " '" & EmailAddressDataTxt & "'"
.Parameters("#PhoneLogin") = " '" & PhoneLoginDataTxt & "'"
.Parameters("#TeamName") = " '" & TeamNameDataTxt & "'"
.Parameters("#TeamSegment") = " '" & TeamSegmentDataTxt & "'"
.Parameters("#StartDate") = " " & StartDateDataTxt & ""
.Parameters("#JobTitle") = " '" & JobTitleDataTxt & "'"
.Execute
End With
adoCN.Close
End Function
SQL Code
EXEC staff.usp_AddNewStaffMember
#Brand = 'CSO North'
, #StaffPrefName = 'Test Agent'
, #NTLoginID = 'TestAgent'
, #NMCUsername = 'TestAgent'
, #StaffAuditLevel = '1'
, #EmailAddress = 'TestAgent#kcom.com'
, #PhoneLogin = '99999'
, #TeamName = 'Customer Services'
, #TeamSegment = 'Customer Services'
, #StartDate = '2017-04-18'
, #JobTitle = 'Test Agent'

How to test the internet connection behind a proxy?

I have this vbscript that works well on Windows 7 32-bit without proxy
In order to improve it, I seek for this solution: How to test internet connection behind a proxy ?
The solution perhaps it will be in VBScript or Powershell or Batch, much as I find a way to check whether i am connected or not behind a proxy !
The piece of code to improve it when i'm behind a proxy
If there is a trick to check if i'm connected to internet when i'm behind a proxy this is my question ?
If CheckConnection = true then
Msgbox "i'm connected to internet",vbinformation+vbSystemModal,"Check connection to internet"
Else
Msgbox "i'm not connected to internet",vbCritical+vbSystemModal,"Check connection to internet"
End if
'***************************************************************************
Function CheckConnection()
CheckConnection = False
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
CheckConnection = True
Exit Function
End If
Next
End Function
'******************************************************************************
The hole code :
Option Explicit
Dim Title,MyScriptPath,DJBuzzRadio,MyLoop,strComputer,objPing,objStatus,FSO,FolderScript,URLICON,Icon
Title = "Radio DJ Buzz Live by © Hackoo © 2015"
MyScriptPath = WScript.ScriptFullName
Set FSO = Createobject("Scripting.FileSystemObject")
FolderScript = FSO.GetParentFolderName(MyScriptPath) 'Chemin du dossier ou se localise le Vbscript
Icon = FolderScript & "\akg.ico"
URLICON = ChrW(104)&ChrW(116)&ChrW(116)&ChrW(112)&ChrW(58)&ChrW(47)&ChrW(47)&ChrW(104)&ChrW(97)&ChrW(99)&ChrW(107)&ChrW(111)&ChrW(111)&ChrW(46)&ChrW(97)&ChrW(108)&ChrW(119)&ChrW(97)&ChrW(121)&ChrW(115)&ChrW(100)&ChrW(97)&ChrW(116)&ChrW(97)&ChrW(46)&ChrW(110)&ChrW(101)&ChrW(116)&ChrW(47)&ChrW(97)&ChrW(107)&ChrW(103)&ChrW(46)&ChrW(105)&ChrW(99)&ChrW(111)
If Not FSO.FileExists(Icon) Then Call Download(URLICON,Icon)
DJBuzzRadio = ChrW(104)&ChrW(116)&ChrW(116)&ChrW(112)&ChrW(58)&ChrW(47)&ChrW(47)&ChrW(119)&ChrW(119)&ChrW(119)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(111)&ChrW(99)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(115)&ChrW(46)&ChrW(99)&ChrW(104)&ChrW(47)&ChrW(100)&ChrW(106)&ChrW(98)&ChrW(117)&ChrW(122)&ChrW(122)&ChrW(114)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(95)&ChrW(119)&ChrW(105)&ChrW(110)&ChrW(100)&ChrW(111)&ChrW(119)&ChrW(115)&ChrW(46)&ChrW(109)&ChrW(112)&ChrW(51)&ChrW(46)&ChrW(97)&ChrW(115)&ChrW(120)
Call Shortcut(MyScriptPath,"DJ Buzz Radio")
MyLoop = True
If CheckConnection = True Then Call AskQuestion()
'***************************************************************************
Function CheckConnection()
CheckConnection = False
While MyLoop = True
strComputer = "smtp.gmail.com"
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}!\\").ExecQuery _
("select * from Win32_PingStatus where address = '" & strComputer & "'")
For Each objStatus in objPing
If objStatus.Statuscode = 0 Then
MyLoop = False
CheckConnection = True
Exit Function
End If
Next
Pause(10) 'To sleep for 10 secondes
Wend
End Function
'***************************************************************************
Sub Play(URL)
Dim Sound
Set Sound = CreateObject("WMPlayer.OCX")
Sound.URL = URL
Sound.settings.volume = 100
Sound.Controls.play
do while Sound.currentmedia.duration = 0
wscript.sleep 100
loop
wscript.sleep (int(Sound.currentmedia.duration)+1)*1000
End Sub
'***************************************************************************
Sub Shortcut(CheminApplication,Nom)
Dim objShell,fso,DesktopPath,objShortCut,MyTab,strCurDir
Set objShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
strCurDir = fso.GetParentFolderName(WScript.ScriptFullName)
MyTab = Split(CheminApplication,"\")
If Nom = "" Then
Nom = MyTab(UBound(MyTab))
End if
DesktopPath = objShell.SpecialFolders("Desktop")
Set objShortCut = objShell.CreateShortcut(DesktopPath & "\" & Nom & ".lnk")
objShortCut.TargetPath = Dblquote(CheminApplication)
ObjShortCut.IconLocation = strCurDir & "\akg.ico"
objShortCut.Save
End Sub
'*****************************************************************************
'Fonction pour ajouter les doubles quotes dans une variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'*****************************************************************************
Function AppPrevInstance()
With GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
With .ExecQuery("SELECT * FROM Win32_Process WHERE CommandLine LIKE " & CommandLineLike(WScript.ScriptFullName) & _
" AND CommandLine LIKE '%WScript%' OR CommandLine LIKE '%cscript%'")
AppPrevInstance = (.Count > 1)
End With
End With
End Function
'******************************************************************************
Function CommandLineLike(ProcessPath)
ProcessPath = Replace(ProcessPath, "\", "\\")
CommandLineLike = "'%" & ProcessPath & "%'"
End Function
'******************************************************************************
Sub Pause(NSeconds)
Wscript.Sleep(NSeconds*1000)
End Sub
'******************************************************************************
Sub AskQuestion()
Dim Question,MsgAR,MsgFR,MsgEN
MsgFR = "Voulez-vous écouter DJ Buzz Radio en direct ?" & vbcr & "Oui = Pour écouter" & vbcr & "Non = Pour arrêter" & vbcr & String(50,"*")
MsgEN = "Did you want to listen to the Radio DJ Buzz Live ?" & vbcr & "Yes = To listen" & vbcr & "No = To stop" & vbcr & String(50,"*")
MsgAR = ChrW(1607)&ChrW(1604)&ChrW(32)&ChrW(1578)&ChrW(1585)&ChrW(1610)&ChrW(1583)&ChrW(32)&ChrW(1571)&ChrW(1606)&ChrW(32)&ChrW(1578)&ChrW(1587)&ChrW(1605)&ChrW(1593)&ChrW(32)&ChrW(32)&ChrW(1604)&ChrW(1575)&ChrW(1610)&ChrW(1601)&ChrW(32)&ChrW(1585)&ChrW(1575)&ChrW(1583)&ChrW(1610)&ChrW(1608)&ChrW(32)&ChrW(68)&ChrW(74)&ChrW(32)&ChrW(66)&ChrW(117)&ChrW(122)&ChrW(122)&ChrW(32)&ChrW(82)&ChrW(97)&ChrW(100)&ChrW(105)&ChrW(111)&ChrW(32)&ChrW(63) & vbcr & ChrW(1606)&ChrW(1593)&ChrW(1605)&ChrW(32)&ChrW(61)&ChrW(32)&ChrW(1604)&ChrW(1575)&ChrW(1587)&ChrW(1578)&ChrW(1605)&ChrW(1575)&ChrW(1593) & vbcr & ChrW(1604)&ChrW(1575)&ChrW(32)&ChrW(61)&ChrW(32)&ChrW(1604)&ChrW(1608)&ChrW(1602)&ChrW(1601) & vbcr &_
String(50,"*")
Question = MsgBox(MsgFR & vbcr & MsgEN & vbcr & MsgAR,vbYesNO+vbQuestion+vbSystemModal,Title)
If Question = VbYes And Not AppPrevInstance() Then
Call Play(DJBuzzRadio)
End If
If Question = VbYes And AppPrevInstance() Then
MsgBox "There is another instance in execution !" & VbCrLF &_
"Il y a une autre instance en cours d'exécution !"& VbcrLF &_
ChrW(1607)&ChrW(1606)&ChrW(1575)&ChrW(1603)&ChrW(32)&ChrW(1605)&ChrW(1579)&ChrW(1575)&ChrW(1604)&ChrW(32)&ChrW(1570)&ChrW(1582)&ChrW(1585)&ChrW(32)&ChrW(1601)&ChrW(1610)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1578)&ChrW(1606)&ChrW(1601)&ChrW(1610)&ChrW(1584)& VbcrLF &_
CommandLineLike(WScript.ScriptName),VbExclamation+vbSystemModal,Title
WScript.Quit()
End If
If Question = VbNo And Not AppPrevInstance() Then
Call Kill("wscript.exe")
End If
If Question = VbNo And AppPrevInstance() Then
Call Kill("wscript.exe")
End If
End Sub
'******************************************************************************
Sub Kill(MyProcess)
Dim Titre,colItems,objItem,Processus,Question
Titre = " Processus "& DblQuote(MyProcess) &" en cours d'exécution "
Set colItems = GetObject("winmgmts:").ExecQuery("Select * from Win32_Process " _
& "Where Name like '%"& MyProcess &"%' AND commandline like " & CommandLineLike(WScript.ScriptFullName) & "",,48)
For Each objItem in colItems
objItem.Terminate(0)' Tuer ce processus
Next
End Sub
'******************************************************************************
Sub Download(strFileURL,strHDLocation)
Dim objXMLHTTP,objADOStream
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
If objXMLHTTP.Status = 200 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
objADOStream.SaveToFile strHDLocation,2
objADOStream.Close
Set objADOStream = Nothing
End If
Set objXMLHTTP = Nothing
Shortcut MyScriptPath,"DJ Buzz Radio"
MsgBox "Un raccourci a été crée sur votre bureau !"& vbcr &_
"A shortcut was created on your desktop !"& vbcr &_
ChrW(1578)&ChrW(1605)&ChrW(32)&ChrW(1573)&ChrW(1606)&ChrW(1588)&ChrW(1575)&ChrW(1569)&ChrW(32)&ChrW(1575)&ChrW(1582)&ChrW(1578)&ChrW(1589)&ChrW(1575)&ChrW(1585)&ChrW(32)&ChrW(1593)&ChrW(1604)&ChrW(1609)&ChrW(32)&ChrW(1587)&ChrW(1591)&ChrW(1581)&ChrW(32)&ChrW(1575)&ChrW(1604)&ChrW(1605)&ChrW(1603)&ChrW(1578)&ChrW(1576),vbSystemModal+vbInformation,Title
End Sub
'**************************************************************************
If you mean the settings of the local computer you can query the registry:
REG QUERY "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings" /v ProxyEnable
If the value is 0x1 then the there is set proxy. You can check also the proxy value through the value of ProxyServer at the same location. More info here.
You can check if your external IP is the same like your internal IP address.
This uses winhttpjs.bat
for /f "skip=1 tokens=* delims=" %%a in ('winhhttpjs.bat "http://www.telize.com/ip" -saveTo con') do (
set "ip=%%a"
)
ipconfig| find "%ip%" || (
echo not real IP/proxy
)

Cannot send the emails through the ASP Form

I am unable to send the email through the form because of the following error. I assume that the form doesn't work because of the depricated CDO? I'm not sure, but also I am not sure how to fix this problem.
CDO.Message.1 error '80040220'
The "SendUsing" configuration value is invalid.
/thankyou.asp, line 24
The Code
<%
Set objMail = Server.CreateObject("CDO.Message")
objMail.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMail.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "localhost"
objMail.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMail.Configuration.Fields.Update
objMail.From = Request.Form("Email") ' change this to an email address
objMail.To = "admin#domain.com" ' change this to your email address
objMail.Subject = "name Questions/Comments" ' change this to your subject
'Set the e-mail body format (HTMLBody=HTML TextBody=Plain)
'Set the e-mail body format (HTMLBody=HTML TextBody=Plain)
objMail.HTMLBody = "<font size=3 face=verdana>"
objMail.HTMLBody = objMail.HTMLBody & "<strong>" & "From: " & "</strong>" & Request.form("Name") & "<br>"
objMail.HTMLBody = objMail.HTMLBody & "<strong>" & "Email: " & "</strong>" & Request.Form("Email") & "<br>"
objMail.HTMLBody = objMail.HTMLBody & "<strong>" & "Phone: " & "</strong>" & Request.Form("Phone") & "<br>" & "<br>"
objMail.HTMLBody = objMail.HTMLBody & "<strong>" & "Questions/Comments: " & "</strong>" & "<br>" & Replace(Request.Form("Details"), vbCrLf, "<br />") & "<br>" & "<br>" & "</font>"
'objMail.HTMLBody = objMail.HTMLBody & "<em>" & "Sent at " & Now() & "</em>" & "</font>"
objMail.Send()
Set objMail = Nothing*
%>
I don't have the access to the physical server and I cannot change the permissions myself.
http://blogs.msdn.com/b/akashb/archive/2010/05/24/error-cdo-message-1-0x80040220-the-quot-sendusing-quot-configuration-value-is-invalid-on-iis-7-5.aspx
Any ideas how can I fix this piece of code to make it work again?
I have tried this: http://forums.iis.net/t/1146477.aspx?The+SendUsing+configuration+value+is+invalid+
Changing SendUsing to 1.
And setting up google snmp to send the emails without much results. Any information would be helpful.
replace your code with this:
<%
Set cdoConfiguration = Server.CreateObject("CDO.Configuration")
With cdoConfiguration
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "localhost"
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Fields("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Fields.Update
End With
Dim tmpStr
tmpStr = ""
tmpStr = "<font size=""3"" face=""verdana"">"
tmpStr = tmpStr & "<ul>"
tmpStr = tmpStr & "<li><strong>" & "From: " & "</strong>: " & Request.form("Name") & "</li>"
tmpStr = tmpStr & "<li><strong>" & "Email: " & "</strong>: " & Request.form("Email") & "</li>"
tmpStr = tmpStr & "<li><strong>" & "Phone: " & "</strong>: " & Request.form("Phone") & "</li>"
tmpStr = tmpStr & "<li><strong>Questions/Comments</strong>:<br/>"
tmpStr = tmpStr & Replace(Request.Form("Details"), vbCrLf, "<br />")
tmpStr = tmpStr & "</li>"
tmpStr = tmpStr & "</ul>"
tmpStr = tmpStr & "<p>Sent at " & Now() & "</p>"
tmpStr = tmpStr & "</font>"
Set newMailObj = Server.CreateObject("CDO.Message")
newMailObj.Configuration = cdoConfiguration
newMailObj.Subject = "name Questions/Comments"
newMailObj.From = Request.Form("Email")
newMailObj.To = "admin#domain.com"
newMailObj.HTMLBody = tmpStr
newMailObj.Send
set newMailObj = nothing
set cdoConfiguration = nothing
%>
and let us know if it works like that, cause if it does, your code (or at least the part you paste to us) is not correct...
and, by the way, if you're using localhost I'm almost sure that the server configuration is not necessary... It is obligatory if you use a remote server like smtp.server.com

Intermittent "The transport failed to connect to the server" CDO error

I am writing an application that sends emails to an admin when there is a problem with the data. The account it's sending through is a Network Solutions SMTP server.
The code works most of the time, but about 1 out of 10 sends fail with the error -2147220973 "The transport failed to connect to the server".
Any suggestions on how to handle this?
Set imsg = CreateObject("cdo.message")
Set iconf = CreateObject("cdo.configuration")
Set Flds = iconf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.OurCompany.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = cdoBasic
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 2525
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "me#OurCompany.com"
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
.Update
End With
With imsg
Set .Configuration = iconf
.To = "me#MyEmail.com" 'CMemail
.From = "resupport#OurCompanycom"
.Subject = ACT
.HTMLBody = "Notification for " & CTName & " of " & CTCname & " " & ACT & ". You must manually Notify them about new docs for " & pname & ". " _
& "<br>Tell " & CTName & " to '" & Nz(DLookup("Notify", "TBLINVOICESETTINGS"), "") & " " & PRName & "_" & pname & ".pdf'"
.Send
End With
Set imsg = Nothing
Set iconf = Nothing
Should the smtpserverport be 25, is it being blocked by firewall?
This piece of code executes correctly :
Sub SMail(pTO As String, pSB As String, pBO As String, pAT As String)
On Error GoTo ErrH: Dim mm As CDO.Message: Set mm = New CDO.Message
mm.Configuration.Fields(cdoSMTPUseSSL) = "True"
mm.Configuration.Fields(cdoSendUsingMethod) = 2
mm.Configuration.Fields(cdoSMTPAuthenticate) = 1
mm.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
mm.Configuration.Fields(cdoSendUserName) = "MyID"
mm.Configuration.Fields(cdoSendPassword) = "MyPW"
'mm.Configuration.Fields(cdoSMTPConnectionTimeout) = 20
'mm.Configuration.Fields(cdoSMTPServerPort) = 25
mm.Configuration.Fields.Update
mm.From = "MyID"
mm.To = pTO
mm.Subject = pSB
mm.TextBody = pBO
mm.AddAttachment (pAT)
mm.send
ErrH: If Err Then MsgBox (Err.Number & " : " & Err.Description)
Set mm = Nothing
End Sub

VB 6 failed send to email server

I am trying to write a program that will send email with an attachment in VB6. I'm using winsock and smtp.gmail.com as my mail server but it doesn't work. Failed to connect to mail server.The code works fine. My only problem is when I try to send message it doesn't connect please help me thanks in advance.
Here's the code
Dim objBase64 As New Base64
Dim bTrans As Boolean
Dim m_iStage As Integer
Dim Sock As Integer
Dim RC As Integer
Dim Bytes As Integer
Dim ResponseCode As Integer
Dim path As String
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Const OFN_READONLY = &H1
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_SHOWHELP = &H10
Const OFN_ENABLEHOOK = &H20
Const OFN_ENABLETEMPLATE = &H40
Const OFN_ENABLETEMPLATEHANDLE = &H80
Const OFN_NOVALIDATE = &H100
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_EXTENSIONDIFFERENT = &H400
Const OFN_PATHMUSTEXIST = &H800
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_CREATEPROMPT = &H2000
Const OFN_SHAREAWARE = &H4000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOTESTFILECREATE = &H10000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOLONGNAMES = &H40000
Const OFN_EXPLORER = &H80000
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_LONGNAMES = &H200000
Const OFN_SHAREFALLTHROUGH = 2
Const OFN_SHARENOWARN = 1
Const OFN_SHAREWARN = 0
Private Declare Function GetSaveFileName Lib "comdlg32" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Private Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function RemoveMenu Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hWnd As Long) As Long
Const MF_BYPOSITION = &H400&
Const MF_REMOVE = &H1000&
Dim Mime As Boolean
Dim arrRecipients As Variant
Dim CurrentE As Integer
Private Sub Attachment_Click()
path = SaveDialog(Me, "*.*", "Attach File", App.path)
If path = "" Then Exit Sub
AttachmentList.AddItem path
Mime = True
AttachmentList.ListIndex = AttachmentList.ListCount - 1
End Sub
Private Sub AttachmentList_Click()
fSize = Int((FileLen(AttachmentList) / 1024) * 100 + 0.5) / 100
AttachmentList.ToolTipText = AttachmentList & " (" & fSize & " KB)"
End Sub
Private Sub AttachmentList_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
For I = 1 To Data.Files.Count
If (GetAttr(Data.Files.Item(I)) And vbDirectory) = 0 Then AttachmentList.AddItem Data.Files.Item(I): Mime = True: AttachmentList.ListIndex = AttachmentList.ListCount - 1
Next I
End Sub
Private Sub DataArrival_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim MsgBuffer As String * 2048
On Error Resume Next
If Sock > 0 Then
Bytes = recv(Sock, ByVal MsgBuffer, 2048, 0)
If Bytes > 0 Then
ServerResponse = Mid$(MsgBuffer, 1, Bytes)
DataArrival = DataArrival & ServerResponse & vbCrLf
DataArrival.SelStart = Len(DataArrival)
If bTrans Then
If ResponseCode = Left$(MsgBuffer, 3) Then
m_iStage = m_iStage + 1
Transmit m_iStage
Else
closesocket (Sock)
Call EndWinsock
Sock = 0
Process = "The Server responds with an unexpected Response Code!"
Exit Sub
End If
End If
ElseIf WSAGetLastError() <> WSAEWOULDBLOCK Then
closesocket (Sock)
Call EndWinsock
Sock = 0
End If
End If
Refresh
End Sub
Private Sub delattach_Click()
If AttachmentList.ListCount = 0 Or AttachmentList.ListIndex = -1 Then Exit Sub
tmpIndex = AttachmentList.ListIndex
AttachmentList.RemoveItem (AttachmentList.ListIndex)
If AttachmentList.ListCount = 0 Then Mime = False: Attachment.ToolTipText = "Drag & Drop your attachments here" Else If AttachmentList.ListIndex = 0 Then AttachmentList.ListIndex = tmpIndex Else AttachmentList.ListIndex = tmpIndex - 1
End Sub
Sub DisableX(frm As Form)
Dim hMenu As Long
Dim nCount As Long
hMenu = GetSystemMenu(frm.hWnd, 0)
nCount = GetMenuItemCount(hMenu)
Call RemoveMenu(hMenu, nCount - 1, MF_REMOVE Or MF_BYPOSITION)
Call RemoveMenu(hMenu, nCount - 2, MF_REMOVE Or MF_BYPOSITION)
DrawMenuBar frm.hWnd
End Sub
Private Sub Exit_Click()
On Error Resume Next
Call Startrek
closesocket Sock
Call EndWinsock
End
End Sub
Private Sub Form_Load()
Call DisableX(Me)
End Sub
Function IsConnected2Internet() As Boolean
On Error Resume Next
If MyIP = "127.0.0.1" Or MyIP = "" Then IsConnected2Internet = False Else IsConnected2Internet = True
End Function
Function SaveDialog(Form1 As Form, Filter As String, Title As String, InitDir As String) As String
Dim ofn As OPENFILENAME
Dim A As Long
ofn.lStructSize = Len(ofn)
ofn.hwndOwner = Form1.hWnd
ofn.hInstance = App.hInstance
If Right$(Filter, 1) <> "|" Then Filter = Filter & "|"
For A = 1 To Len(Filter)
If Mid$(Filter, A, 1) = "|" Then Mid$(Filter, A, 1) = Chr$(0)
Next A
ofn.lpstrFilter = Filter
ofn.lpstrFile = Space$(254)
ofn.nMaxFile = 255
ofn.lpstrFileTitle = Space$(254)
ofn.nMaxFileTitle = 255
ofn.lpstrInitialDir = InitDir
ofn.lpstrTitle = Title
ofn.flags = OFN_HIDEREADONLY Or OFN_CREATEPROMPT
A = GetSaveFileName(ofn)
If (A) Then
SaveDialog = Left$(Trim$(ofn.lpstrFile), Len(Trim$(ofn.lpstrFile)) - 1)
Else
SaveDialog = ""
End If
End Function
Private Sub SendMimeAttachment()
Dim FileIn As Long
Dim temp As Variant
Dim s As Variant
Dim TempArray() As Byte
Dim Encoded() As Byte
Dim strFile As String
Dim strFile1 As String * 32768
For IAT = 0 To AttachmentList.ListCount - 1
path = AttachmentList.List(IAT)
Mimefilename = Trim$(Right$(path, Len(path) - InStrRev(path, "\")))
FileIn = FreeFile
r
temp = vbCrLf & "--NextMimePart" & vbCrLf
temp = temp & "Content-Type: application/octet-stream; name=Mimefilename" & vbCrLf
temp = temp & "Content-Transfer-Encoding: base64" & vbCrLf
temp = temp & "Content-Disposition: attachment; filename=" & Chr$(34) & Mimefilename & Chr$(34) & vbCrLf
WinsockSendData (temp & vbCrLf)
Open path For Binary Access Read As FileIn
If GetSetting(App.Title, "Settings", "Too big", "") <> "True" Then
If LOF(FileIn) > 2097152 Then
fSize = Int((LOF(FileIn) / 1048576) * 100 + 0.5) / 100
Setu = MsgBox("The current file is " & fSize & " MB of size, extracting from it could take a few minutes, Click Yes to go ahead, No to skip it or Cancel if you don't want to get this message again", vbYesNoCancel)
If Setu = vbYes Then GoTo Cont
If Setu = vbNo Then Close (FileIn): GoTo Anoth Else SaveSetting App.Title, "Settings", "Too big", "True"
End If
End If
Cont:
frm2.Visible = True
Process = "Loading """ & AttachmentList.List(IAT) & """"
Do While Not EOF(FileIn)
If LOF(FileIn) = 0 Then GoTo Anoth
Get FileIn, , strFile1
strFile = strFile & Mid$(strFile1, 1, Len(strFile1) - (Loc(FileIn) - LOF(FileIn)))
strFile1 = ""
DoEvents
frm2.Width = (3300 / 100) * (Len(strFile) * 50 / LOF(FileIn))
lblpcent = Int(Len(strFile) * 50 / LOF(FileIn)) & "%"
If Cancelflag Then Close FileIn: Exit Sub
Loop
Close FileIn
If strFile = "" Then Exit Sub
objBase64.Str2ByteArray strFile, TempArray
objBase64.EncodeB64 TempArray, Encoded
objBase64.Span 76, Encoded, TempArray
strFile = ""
s = StrConv(TempArray, vbUnicode)
For I = 1 To Len(s) Step 8192
ss = Trim$(Mid$(s, I, 8192))
tmpServerSpeed = 150
Start = timeGetTime
Do
DoEvents
Loop Until timeGetTime >= Start + tmpServerSpeed * 20
WinsockSendData (ss)
frm2.Width = 1650 + (3300 / 100) * ((I + Len(ss)) * 50 / Len(s))
lblpcent = 50 + Int((I + Len(ss)) * 50 / Len(s)) & "%"
Process = "Sending " & Mimefilename & "... " & I + Len(ss) & " Bytes from " & Len(s)
DoEvents
Next I
Anoth:
s = ""
Next IAT
WinsockSendData (vbCrLf & "--NextMimePart--" & vbCrLf)
WinsockSendData (vbCrLf & "." & vbCrLf)
End Sub
Private Sub SendMimeConnect_Click()
If Tobox = "" Or InStr(Tobox, "#") = 0 Then
MsgBox "To: Is not correct!"
Exit Sub
End If
If IsConnected = False Then
If MsgBox("No Internet connection has been detected, check for Update anyway?", vbYesNo) = vbNo Then Exit Sub
End If
Sock = ConnectSock(MailServer, 25, DataArrival.hWnd)
If Sock = SOCKET_ERROR Then
Process = "Cannot Connect to " & MailServer & GetWSAErrorString(WSAGetLastError())
closesocket Sock
Call EndWinsock
Exit Sub
End If
Process = "Connected to " & MailServer
bTrans = True
m_iStage = 0
DataArrival = ""
ResponseCode = 220
Call WaitForResponse
End Sub
Sub SendMimetxt(txtFrom, txtTo, txtSubjekt, txtMail)
Dim strToSend As String
Dim strDataToSend As String
If Mime Then
strDataToSend = "From: " & txtFrom & vbCrLf
strDataToSend = strDataToSend & "To: " & txtTo & vbCrLf
strDataToSend = strDataToSend & "Date: " & Format$(Now, "DDDD , dd Mmm YYYY hh:mm:ss AM/PM") & vbCrLf
strDataToSend = strDataToSend & "Subject: " & txtSubjekt & vbCrLf
strDataToSend = strDataToSend & "X-Mailer: " & App.CompanyName & " - " & App.Title & vbCrLf
strDataToSend = strDataToSend & "Mime-Version: 1.0" & vbCrLf
strDataToSend = strDataToSend & "Content-Type: multipart/mixed; boundary=NextMimePart" & vbCrLf
strDataToSend = strDataToSend & "Content-Transfer-Encoding: 7bit" & vbCrLf
strDataToSend = strDataToSend & "This is a multi-part message in MIME format." & vbCrLf & vbCrLf
strDataToSend = strDataToSend & "--NextMimePart" & vbCrLf & vbCrLf
strDataToSend = strDataToSend & Trim$(Mailtxt)
strDataToSend = Replace$(strDataToSend, vbCrLf & "." & vbCrLf, vbCrLf & "." & Chr$(0) & vbCrLf)
For I = 1 To Len(strDataToSend) Step 8192
strToSend = Trim$(Mid$(strDataToSend, I, 8192))
WinsockSendData (strToSend)
frm2.Width = (2400 / 100) * ((I + Len(strToSend)) * 100 / Len(strDataToSend))
lblpcent = Int((I + Len(strToSend)) * 100 / Len(strDataToSend)) & "%"
If Cancelflag Then Exit For
Process = "Sending message body... " & I + Len(strToSend) & " Bytes from " & Len(strDataToSend)
DoEvents
Next I
SendMimeAttachment
Else
strDataToSend = "From: " & txtFrom & vbCrLf
strDataToSend = strDataToSend & "To: " & txtTo & vbCrLf
strDataToSend = strDataToSend & "Date: " & Format$(Now, "DDDD , dd Mmm YYYY hh:mm:ss AM/PM") & vbCrLf
strDataToSend = strDataToSend & "Subject: " & txtSubjekt & vbCrLf
strDataToSend = strDataToSend & "X-Mailer: " & App.CompanyName & " - " & App.Title & vbCrLf & vbCrLf
strDataToSend = strDataToSend & Trim$(txtMail)
strDataToSend = Replace$(strDataToSend, vbCrLf & "." & vbCrLf, vbCrLf & "." & Chr$(0) & vbCrLf)
For I = 1 To Len(strDataToSend) Step 8192
strToSend = Trim$(Mid$(strDataToSend, I, 8192))
WinsockSendData (strToSend)
frm2.Width = (2400 / 100) * ((I + Len(strToSend)) * 100 / Len(strDataToSend))
lblpcent = Int((I + Len(strToSend)) * 100 / Len(strDataToSend)) & "%"
If Cancelflag Then Exit For
Process = "Sending message body... " & I + Len(strToSend) & " Bytes from " & Len(strDataToSend)
DoEvents
Next I
WinsockSendData (vbCrLf & "." & vbCrLf)
End If
End Sub
Sub Startrek()
On Error Resume Next
Dim Rate As Integer
Dim Rate2 As Integer
If WindowState <> 0 Then Exit Sub
Caption = "End Transmission"
GotoVal = (Height / 12)
Rate = 50
For Gointo = 1 To GotoVal
Spd = Timer
Rate2 = Rate / 2
Height = Height - Rate
Top = Top + Rate2
DoEvents
Width = Width - Rate
Left = Left + Rate2
DoEvents
If Width <= 2000 Then Exit For
Rate = (Timer - Spd) * 10000
Next Gointo
WindowState = 1
End Sub
Private Sub Tobox_Change()
arrRecipients = Split(Tobox, ",")
End Sub
Private Sub Transmit(iStage As Integer)
Dim Helo As String
Dim pos As Integer
Select Case m_iStage
Case 1
Helo = Frombox
pos = Len(Helo) - InStr(Helo, "#")
Helo = Right$(Helo, pos)
ResponseCode = 250
WinsockSendData ("HELO " & Helo & vbCrLf)
Call WaitForResponse
Case 2
ResponseCode = 250
WinsockSendData ("MAIL FROM: <" & Trim$(Frombox) & ">" & vbCrLf)
Call WaitForResponse
Case 3
ResponseCode = 250
WinsockSendData ("RCPT TO: <" & Trim$(arrRecipients(CurrentE)) & ">" & vbCrLf)
Call WaitForResponse
Case 4
ResponseCode = 354
WinsockSendData ("DATA" & vbCrLf)
Call WaitForResponse
Case 5
ResponseCode = 250
Call SendMimetxt(Frombox, Trim$(arrRecipients(CurrentE)), Subjekt, Mailtxt)
Call WaitForResponse
Case 6
ResponseCode = 221
WinsockSendData ("QUIT" & vbCrLf)
Call WaitForResponse
Process = "Email has been sent!"
frm2.Width = 3300
lblpcent = "100%"
DataArrival = ""
m_iStage = 0
If arrRecipients(CurrentE + 1) <> "" Then
CurrentE = CurrentE + 1
SendMimeConnect_Click
Else
bTrans = False
CurrentE = 0
End If
End Select
End Sub
Private Sub WaitForResponse()
Dim Start As Long
Dim Tmr As Long
Start = timeGetTime
While Bytes > 0
Tmr = timeGetTime - Start
DoEvents '
If Tmr > 20000 Then
Process = "SMTP service error, timed out while waiting for response"
End If
Wend
End Sub
Private Sub WinsockSendData(DatatoSend As String)
Dim RC As Integer
Dim MsgBuffer As String * 8192
MsgBuffer = DatatoSend
RC = send(Sock, ByVal MsgBuffer, Len(DatatoSend), 0)
If RC = SOCKET_ERROR Then
Process = "Cannot Send Request." & Str$(WSAGetLastError()) & _
GetWSAErrorString(WSAGetLastError())
closesocket Sock
Call EndWinsock
Exit Sub
End If
End Sub
I didn't bother to read your code. Too hard. Here's how to do it easily.
Set emailObj = CreateObject("CDO.Message")
emailObj.From = "dc#gail.com"
emailObj.To = "dc#gail.com"
emailObj.Subject = "Test CDO"
emailObj.TextBody = "Test CDO"
emailObj.AddAttachment "c:\windows\win.ini"
Set emailConfig = emailObj.Configuration
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = true
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = "YourUserName"
emailConfig.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Password1"
emailConfig.Fields.Update
emailObj.Send
If err.number = 0 then Msgbox "Done"
Here's how to get files from internet with a high level object. You must use the exact name with http:// as there no helper for incorrect addresses.
Set File = WScript.CreateObject("Microsoft.XMLHTTP")
File.Open "GET", "http://www.microsoft.com", False
File.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 8.0; Windows NT 6.0; Trident/4.0; SLCC1; .NET CLR 2.0.50727; Media Center PC 5.0; .NET CLR 1.1.4322; .NET CLR 3.5.30729; .NET CLR 3.0.30618; .NET4.0C; .NET4.0E; BCD2000; BCD2000)"
File.Send
txt=File.ResponseText
Also for binary files use ado stream. To create a database in memory use adodb recordset (better than a dictionary, array, or a collection), makes sorting a one line command.