I'm trying to send an email with VB script/ASP (I don't normally use this language but this is what the site is built in), and it is throwing a 500 error.
I'm not seeing what I did wrong. Everything looks like it should execute to me. Any ideas?
<%
dim name
dim from
dim company
dim phone
dim zip
dim message
dim areas
name = Request.Form("name")
from = Request.Form("from")
company = Request.Form("company")
phone = Request.Form("phone")
zip = Request.Form("zip")
areas = Request.Form("areas")
message = Request.Form("message")
Dim Mail, strHost
Dim strSubject, strBody, strPath
strHost = "localhost"
Set Mail = Server.CreateObject("Persits.MailSender")
Mail.Host = strHost
Mail.From = "cphelps#client.com"
Mail.FromName = "Client Name"
Mail.AddAddress "cphelps#client.com"
If Not InStr(from, "domain.com") Then Mail.AddBcc "cphelps#client.com"
Mail.Subject = name & " sent a request"
Mail.Body = name & "," & vbCrLf & vbCrLf &_
"Name:" & name & vbCrLf &_
"Company: " & company & vbCrLf &_
"From: " & from & vbCrLf &_
"Phone: " & phone & vbCrLf &_
"Zip Code: " & zip & vbCrLf &_
"Message: " & message & vbCrLf &_
Mail.Send
Response.Redirect("jlg_thank_you.asp")
set Mail = nothing
%>
The first thing I noticed is that you are missing an End If in the code sample provided.
I disabled Friendly error messages and I attempted to run the code and got this error:
Server object error 'ASP 0177 : 800401f3'
Server.CreateObject Failed
/test.asp, line 26
800401f3
On researching this error I found someone with a similar problem:
Server.createObject with Persist.Mailsender error
They suggested that its a missing dll problem.
For my projects I have used Server.CreateObject("CDO.Message")
Here is an example of my code:
Set mail = Server.CreateObject("CDO.Message")
mail.To = varTo
mail.From = varFrom
mail.Subject = varSubject
mail.HTMLBody = varBody
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtp.domain.com"
mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
mail.Configuration.Fields.Update
mail.Send
Make sure you downloaded the latest version of ASPEmail and that it is present on the server running the script.
Also, register it using this command line:
regsvr32 c:\path\aspemail.dll
Related
OK so I have a script that goes through my outlook inbox looking for a particular header string. This works great for emails directly in my inbox. Now I'm trying to expand this detection to emails that contain other emails as attachments. I've spent significant time researching this and I can't seem to find the proper way to access the email attachment directly. What I've ended up doing is saving the attachment to disc and then reading it back in using CreateItemFromTemplate. I find this to be a cludge solution and I'm hoping someone here can help me find a more elegant way to do this where I can bypass the saveas as CreateItemFromTemplate and directly create an item object from the attachment. Here is proof of concept script I've put together for this:
Const olFolderInbox = 6
Const olMail = 43
Const olEmbeddeditem = 5
Const PropName = "http://schemas.microsoft.com/mapi/proptag/0x007D001E"
Set app = CreateObject("Outlook.Application")
set objNamespace = app.GetNamespace("MAPI")
set objInboxItems = objNameSpace.GetDefaultFolder(olFolderInbox).items
wscript.echo "Have your inbox open checking for fish tests or emails as attachments"
for each objItem in objInboxItems
if objItem.Class = olMail then
with objItem
strHeader = .PropertyAccessor.GetProperty(PropName)
iLoc1 = instr(1,strHeader,"X-Testing",1)
if iLoc1 > 0 then
wscript.echo "mytest. From: " & .Sender & " at: " & .ReceivedTime & " subjet: " & .Subject
end if
iLoc1 = instr(1,strHeader,"X-PHISHTEST",1)
if iLoc1 > 0 then
wscript.echo "Go Fish. From: " & .Sender & " at: " & .ReceivedTime & " subjet: " & .Subject
end if
if .attachments.count > 0 then
set objAttachment = .attachments.item(1)
if objAttachment.type = olEmbeddeditem then
wscript.echo "Has Attachment. From: " & .Sender & " at: " & .ReceivedTime & " subjet: " & .Subject
wscript.echo " - Filename: " & objAttachment.Filename
objAttachment.SaveAsFile ("c:\temp\TempEmail.msg")
set objExtMsg = app.CreateItemFromTemplate("c:\temp\TempEmail.msg")
strExtHeader = objExtMsg.PropertyAccessor.GetProperty(PropName)
iLoc1 = instr(1,strExtHeader,"X-Testing",1)
if iLoc1 > 0 then wscript.echo " ++ This is a plain test message"
end if
end if
end with
end if
next
wscript.echo "That's all folks" `
That is the best you can do in OOM alone - save the attachment as an MSG file and then reopen it. OpenSharedItem is a better way to open an MSG file than CreateItemFromTemplate.
On the Extended MAPI level (C++ or Delphi), you can open the PR_ATTACH_DATA_OBJ property as IMessage using IAttach::OpenProperty. If Extended MAPI is not an option, you can use Redemption (I am its author - any language) - both Safe*Item and RDO families of objects expose EmbeddedMsg property on the attachment object that return the attachment message.
I'm new to Vb6. I just want to know how to use my sms code to send all the numbers in the rows in a specific column. In this code, the messages i received are more than what i want to receive. Please help me fix my looping method.
Dim x As String
Dim e As Integer
Dim allcontacts As String
For i = 0 To DataGrid1.VisibleRows
For e = 0 To DataGrid1.ApproxCount - 1
allcontacts = DataGrid1.Columns(5).CellValue(DataGrid1.GetBookmark(e))
' Send an 'AT' command to the phone
MSComm1.Output = "AT" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGF=1" & vbCrLf 'This line can be removed if your modem will always be in Text Mode...
Sleep 500
MSComm1.Output = "AT+CMGS=" & Chr(34) & allcontacts & Chr(34) & vbCrLf 'Replace this with your mobile Phone's No.
Sleep 1000
MSComm1.Output = "From School Activities Management System: " & vbCrLf & vbCrLf & "The time now is " & Label3.Caption & vbCrLf & vbCrLf & "Announcement:" & vbCrLf & Text1.Text & Chr(26)
Sleep 2000
Next e
Next i
x = DataGrid1.VisibleRows
MsgBox "Message Sent to " + x + " contacts in faculty."
End Sub
Here's a screenshot of the datagrid:
Based upon your screenshot, it looks like you want to send 1 sms for each row. Therefore, I would try the following code:
Dim i As Integer
Dim allcontacts As String
For i = 0 To DataGrid1.VisibleRows - 1
allcontacts = DataGrid1.Columns(5).CellValue(DataGrid1.GetBookmark(i))
' Send an 'AT' command to the phone
MSComm1.Output = "AT" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGF=1" & vbCrLf 'This line can be removed if your modem will always be in Text Mode...
Sleep 500
MSComm1.Output = "AT+CMGS=" & Chr(34) & allcontacts & Chr(34) & vbCrLf 'Replace this with your mobile Phone's No.
Sleep 1000
MSComm1.Output = "From School Activities Management System: " & vbCrLf & vbCrLf & "The time now is " & Label3.Caption & vbCrLf & vbCrLf & "Announcement:" & vbCrLf & Text1.Text & Chr(26)
Sleep 2000
Next i
MsgBox "Message Sent to " & DataGrid1.VisibleRows & " contacts in faculty."
One thing to keep in mind is that messages will only be sent for those rows that are visible on the screen. If they are scrolled off the screen and can't be seen then no message will be sent.
Apologies in advance for any incorrect terminology (I am a PC Tech, not a developer/programmer).
We have a VBScript running in one of our servers to send an email notice to users that their Windows password will expire and they need to change it. The script is as follows:
*******************Begin Code*****
on error resume next
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work
ReminderAge = 10 'Days before the reminders start being sent
'strbody - Body of the message being sent
strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
strbody = strbody & "the IT Department" & vbcrlf
strbody = strbody & vbcrlf & "Thank you," & vbcrlf
strbody = strbody & "IT Department"
'create logfile
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & TwoDigits(Hour(now)) & TwoDigits(Minute(now)) &
TwoDigits(Second(now)) & ".txt"
strLogFile = strScriptPath & "Logs\" & StrLogName
Set objLogFile = objFSO.CreateTextFile(strLogFile,1)
objLogfile.Writeline "Email Password Check Script started: " & Now
Dim rootDSE,domainObject
Set rootDSE = GetObject("LDAP://RootDSE")
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
DomainContainer = rootDSE.Get("defaultNamingContext")
Set fs = CreateObject ("Scripting.FileSystemObject")
Set conn = CreateObject("ADODB.Connection")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
numDays = CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(-864000000000)
'LDAP string to only find user accounts with mailboxes
ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*) (|
(&(objectCategory=person)(objectClass=user)(!(homeMDB=*))(!(msExchHomeServerName=*)))(&(objectCategory=person)(objectClass=user)(|(homeMDB=*)(msExchHomeServerName=*))) ));adspath;subtree"
Set rs = conn.Execute(ldapStr)
While Not rs.EOF
Set oUser = GetObject (rs.Fields(0).Value)
dtmValue = oUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
whenpasswordexpires = "The password has never been set."
else
whenPasswordExpires = DateAdd("d", numDays, oUser.PasswordLastChanged)
end if
daysb4expire = Int(whenPasswordExpires - Now)
'write user info to logfile
objLogfile.Writeline "-----------------------------------------"
objLogfile.Writeline "SAM Acct: " & oUser.SamAccountName
objLogfile.Writeline "Disp Name: " & oUser.displayName
objLogfile.Writeline "UPN: " & oUser.userprincipalname
objLogfile.Writeline "PW Changed: " & oUser.PasswordLastChanged
objLogfile.Writeline "PW Expires: " & whenPasswordExpires
dblMaxPwdNano = Abs(MaxPwdAge.HighPart * 2^32 + MaxPwdAge.LowPart)
dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
dblMaxPwdDays = Int(dblMaxPwdSecs / SECONDS_IN_DAY)
objLogfile.Writeline "The password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)."
if daysb4expire < ReminderAge and daysb4expire > 0 then
objLogfile.Writeline "Expiring soon - sending eMail"
objLogfile.Writeline "*****************************"
strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
strNoteMessage = strNoteMessage & "Your Network password will expire on " & _
DateValue(dtmValue + dblMaxPwdDays) & " (" & _
Int((dtmValue + dblMaxPwdDays) - Now) & " days from today)." & vbcrlf & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "me#myCompany.com" 'Your From Address
objEmail.To = oUser.userprincipalname
objEmail.Subject = "Network Password Expiration Notice" 'Message subject
objEmail.TextBody = strNoteMessage & strBody
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") =
"YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
'objEmail.Send 'commented out right now---so you won't send out the email.
End If
set whenpasswordexpires = nothing
err.clear
rs.MoveNext
Wend
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
Logfile.Close
Function TwoDigits(t)
TwoDigits = Right("00" & t,2)
End Function
WScript.quit
Obviously I removed our info from the script for this post.
The errors are that:
It does not send an email everyday if the user does not change their password for a few days. It sends them randomly.
A few random users, if they have not changed their password, around the 5th or 6th day will start getting hundreds of thousands of emails in just a few seconds, completely locking down Outlook on their computer. If they change the password they stop getting them (obviously).
Is there something I'm missing or need to remove from this script to get it to at least stop sending so many emails at once?
Thank you.
A couple of ideas to help you track down the problem.
Only have on error resume next before the command that needs it oUser.PasswordLastChanged, after that line on error goto 0 Then run the script manually and you'll have a better chance of finding some statement that is failing. update - should store the value in a variable and use
Get consistent with what variables are for. whenpasswordexpires is set to text in one part of the if err.number and a date in the other. It's then used as a date to calculate days and finally set whenpasswordexpires = nothing treats it like an object. This could mean some of your if statements are erroring and just going to the next line, instead of skipping the if - so people might be getting mailed when they shouldn't.
Consider calculating a date to pass to the LDAP query and only return people to be emailed - instead of going through all users all the time
(without ever having much to do with LDAP queries) I think your current query simplifies down to ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user));adspath;subtree" all the ors and ands with homeMDB and msExchHomeServerName would seem to mean any combination is included. It's probably worth running your query in an LDAP explorer tool to check you're really getting what you want.
LDAP often has a limit of the number of records returned, so you might be erroring all the time because you get more than 1000 (typical) records returned. This can be worked around by getting data in smaller pages (say 250).
Logging to a new file each time may hide issues from you, e.g if the task is restarted by scheduler. Much easier to diagnose if there is just one log per day. You also don't close the log file correctly - should be objLogFile.Close (not logfile.Close). You aren't putting the log in a subdirectory of the scripts folder (e.g. scripts & scripts\logs) but at the same level (e.g. scripts & scriptsLogs)
The logfile not objLogFile issue highlights why it is best to put Option Explicit at the top of your code. This means you have to dim every variable that you use, which can be a pain to do, but ensures that you don't have typos in your variable names which can cause you massive headaches.
The WScript.Quit is the very last line, so won't do anything - the codes about to finish anyway. If you ever want to abort the execution of script, the WScript.Quit needs to where you want to abort from - normally within some if statement.
There are a number of repeated calculations... days, dtmValue + dblMaxPwdDays, etc. I just mention this as it makes the code harder to read and therefore harder to understand what might be wrong.
All that said, I've probably made too many comments now for you to really comprehend without me just making the changes and posting updated script for you to try.
See if this version runs error free for you...
option explicit
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND = &h8000500D
Const ONE_HUNDRED_NANOSECOND = .000000100
Const SECONDS_IN_DAY = 86400
Dim strDomainDN, strBody, strNoteMessage
Dim objFSO, objLogFile, objEmail
Dim strScriptPath, strLogName, strLogFile
strDomainDN = "DomainNameHere" 'Domain name here - both Netbios and DNS style names should work
Const ReminderAge = 10 'Days before the reminders start being sent
'strbody - Body of the message being sent
strbody = "This message is a reminder that your password will be expiring soon." & vbcrlf
strbody = strbody & "Please change your network password before the date listed above to avoid being locked out of the system." & vbcrlf
strbody = strbody & "If you need instructions on how to change your password please contact:" & vbcrlf
strbody = strbody & "the IT Department" & vbcrlf
strbody = strbody & vbcrlf & "Thank you," & vbcrlf
strbody = strbody & "IT Department"
'create logfile
Set objFSO = CreateObject("Scripting.FileSystemObject")
strScriptPath = objfso.GetParentFolderName(WScript.ScriptFullName)
strLogName = TwoDigits(Year(now)) & TwoDigits(Month(now)) & TwoDigits(Day(now)) & ".txt"
strLogFile = strScriptPath & "Logs\" & StrLogName
Set objLogFile = objFSO.OpenTextFile(strLogFile, 8, True)
objLogFile.Writeline "Email Password Check Script started: " & Now
Dim rootDSE, oDomain, DomainContainer
Dim maxPwdAge, numDays
Dim conn, command
Dim ldapStr
Dim rs, oUser, passwordChanged, whenPasswordExpires, daysb4expire
Set rootDSE = GetObject("LDAP://RootDSE")
Set oDomain = GetObject("LDAP://" & strDomainDN)
Set maxPwdAge = oDomain.Get("maxPwdAge")
DomainContainer = rootDSE.Get("defaultNamingContext")
Set conn = CreateObject("ADODB.Connection")
Set command = CreateObject("ADODB.Command")
conn.Provider = "ADSDSOObject"
conn.Open "ADs Provider"
Set command.ActiveConnection = conn
command.Properties("Page Size") = 250
numDays = ABS(CCur((maxPwdAge.HighPart * 2 ^ 32) + maxPwdAge.LowPart) / CCur(864000000000))
'LDAP string to only find user accounts with mailboxes
Dim dteCnv, sec1601, strExpireDate, strRemindDate
dteCnv = DateAdd("d", -numDays, Now)
sec1601 = DateDiff("s","1/1/1601",dteCnv)
strExpireDate = CStr(sec1601) & "0000000"
dteCnv = DateAdd("d", ReminderAge - numDays, Now)
sec1601 = DateDiff("s","1/1/1601",dteCnv)
strRemindDate = CStr(sec1601) & "0000000"
ldapStr = "<LDAP://" & DomainContainer & ">;(& (mailnickname=*)(objectCategory=person)(objectClass=user)(pwdLastSet>=" & strExpireDate & ")(pwdLastSet<=" & strRemindDate & "));adspath;subtree"
command.CommandText = ldapStr
Set rs = command.Execute
While Not rs.EOF
Set oUser = GetObject (rs.Fields(0).Value)
on error resume next
passwordChanged = oUser.PasswordLastChanged
If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
passwordChanged = "Never"
whenPasswordExpires = Now
elseIf Err.Number <> 0 Then
passwordChanged = "Unknown - " & Err.Description
whenPasswordExpires = Now
else
whenPasswordExpires = DateAdd("d", numDays, passwordChanged)
end if
on error goto 0
daysb4expire = Int(whenPasswordExpires - Now)
'write user info to logfile
objLogFile.Writeline "-----------------------------------------"
objLogFile.Writeline "SAM Acct: " & oUser.SamAccountName
objLogFile.Writeline "Disp Name: " & oUser.displayName
objLogFile.Writeline "UPN: " & oUser.userprincipalname
objLogFile.Writeline "PW Changed: " & passwordChanged
objLogFile.Writeline "PW Expires: " & whenPasswordExpires
objLogFile.Writeline "The password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)."
if daysb4expire <= ReminderAge and daysb4expire > 0 then
objLogFile.Writeline "Expiring soon - sending eMail"
objLogFile.Writeline "*****************************"
strNoteMessage = "Dear " & oUser.displayName & "," & vbcrlf & vbcrlf
strNoteMessage = strNoteMessage & "Your Network password will expire on " & whenPasswordExpires & " (" & daysb4expire & " days from today)." & vbcrlf & vbcrlf
Set objEmail = CreateObject("CDO.Message")
objEmail.From = "me#myCompany.com" 'Your From Address
objEmail.To = oUser.userprincipalname
objEmail.Subject = "Network Password Expiration Notice" 'Message subject
objEmail.TextBody = strNoteMessage & strBody
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "YOUREXCHANGE.SERVER.DomainName.COM" ' Your mailserver here
objEmail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
'objEmail.Send 'commented out right now---so you won't send out the email.
End If
err.clear
rs.MoveNext
Wend
Set oUser = Nothing
Set maxPwdAge = Nothing
Set oDomain = Nothing
objLogFile.Writeline "Email Password Check completed: " & Now & vbcrlf & vbcrlf
objLogFile.Close
Function TwoDigits(t)
TwoDigits = Right("00" & t,2)
End Function
I want to retrieve and process some Web pages with VBScript, which is being run from the command line. It bears mentioning that I'm on a work computer, and "some setting are managed by your system administrator". Also, I log in to the computer with a CAC, so (and I think this is the problem) there are certificates involved.
My problem is that, frequently, when I run the VBScript I'll get back a 401/unauthorized error, for both HTTPS and non-HTTPS sites. If I then open the URL in a browser, the script (still being run from the command line) will work. If I run the script on my home computer I can always access any URL without first having to open it in a browser. So, I'm guessing it has to do with either the certificates in my CAC (which are also installed on the computer), or some other certificate on the computer, that are used to authenticate the connection (or some such thing).
My question is: how can I retrieve various Web pages using VBScript (without installing any additional software) without having to first open the URL in a browser to get the script to work?
Here is my code for getting a Web page, if that helps:
function getWebPage(sURL)
dim iErrorCount
on error resume next
'******************
'ERROR CHECKING OFF
'******************
oHTTP.Open "GET", sURL, False
oHTTP.Send
if (err.number <> 0) then
iErrorCount = 0
do
iErrorCount = iErrorCount + 1
log "log.txt", "Error retrieving Web page. Error #0x" & hex(err.number) & ". Description: " & err.description, 0, true
if (iErrorCount = 5) then
log "log.txt", vbTab & "Five successive errors retrieving Web page. Exiting...", 1, true
msgbox "ERROR: Five successive errors retrieving " & chr(34) & sURL & chr(34) & vbCRLF & vbCRLF & "See the log file for details." & vbCRLF & vbCRLF & "Exiting...", vbOkOnly, programName
log "last result.html", oHTTP.ResponseText, 0, false
wscript.quit
else
wscript.sleep iErrorCount * 60000
set oHTTP = nothing
set oHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
oHTTP.Open "GET", sURL, False
oHTTP.Send
end if
loop until (err.number = 0)
end if
on error goto 0
'*****************
'ERROR CHECKING ON
'*****************
if (oHTTP.Status <> 200) then
log "log.txt", vbcrlf & vbtab & "Error retrieving Web page" & vbcrlf & vbtab & "URL: " & sURL & vbcrlf & vbtab & "Status: " & oHTTP.Status & vbcrlf & vbtab & "Description: " & oHTTP.statusText, 1, true
msgbox "ERROR: Cannot retrieve Web page." & vbCRLF & vbCRLF & "See the log file for details." & vbCRLF & vbCRLF & "Exiting...", vbOkOnly, programName
wscript.quit
else
' log "last result.html", oHTTP.ResponseText, 0, false
getWebPage = oHTTP.ResponseText
end if
end function
Any thoughts?
You have to get the url exactly right with xmlhttp object. Run this code and print out the error messages (you can copy a messagebox with Ctrl + C).
Set fso = CreateObject("Scripting.FileSystemObject")
Set Outp = Wscript.Stdout
On Error Resume Next
Set File = WScript.CreateObject("Microsoft.XMLHTTP")
File.Open "GET", "ftp://ftp.microsoft.com/Softlib/README.TXT", 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
If err.number <> 0 then
line =""
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "Error getting file"
Line = Line & vbcrlf & "=================="
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "Error " & err.number & "(0x" & hex(err.number) & ") " & err.description
Line = Line & vbcrlf & "Source " & err.source
Line = Line & vbcrlf & ""
Line = Line & vbcrlf & "HTTP Error " & File.Status & " " & File.StatusText
Line = Line & vbcrlf & File.getAllResponseHeaders
wscript.echo Line
Err.clear
wscript.quit
End If
On Error Goto 0
Set BS = CreateObject("ADODB.Stream")
BS.type = 1
BS.open
BS.Write File.ResponseBody
BS.SaveToFile "c:\users\safetyscanner.exe", 2
I have the following CDONTS code that works fine:
Dim CDONTSMail
Set CDONTSMail = CreateObject("CDONTS.NewMail")
CDONTSMail.From= "me#gmail.com"
CDONTSMail.To= "me#gmail.com"
CDONTSMail.Subject= "500.100 Error: " & objASPError.File
strBody = "This is a test message." & vbCrLf
CDONTSMail.Body= sErrorMes
CDONTSMail.Send
set CDONTSMail=nothing
However the following when used in a loop errors out? any ideas?
'Create Mailer object and send message
CDONTSMail.From= "me#gmail.com"
CDONTSMail.To = Session("Email")
CDONTSMail.Subject = Subject
strBody = MainMessage & vbCrLf
CDONTSMail.Body= strBody
CDONTSMail.Send
You need to set CDONTSMail again.
Try this in your loop:
Set CDONTSMail = CreateObject("CDONTS.NewMail")
CDONTSMail.From= "me#gmail.com"
CDONTSMail.To= "me#gmail.com"
CDONTSMail.Subject = Subject
strBody = MainMessage & vbCrLf
CDONTSMail.Body= strBody
CDONTSMail.Send
set CDONTSMail=nothing