I'm using classic ASP and sending an email via CDO and i need to send the following as a link in the body of the email.
http://example.co.uk/Uploaded_Files/<%=RealFileName%>
> ' we are sending a text email.. simply switch the comments around to
> send an html email instead ObjSendMail.HTMLBody = "<h2 align=center>"
> & "<a href="http://example.co.uk/Uploaded_Files/" " &
> Request.Form("filenamex") & "">View File</a>"
The above code come back with this error,
Microsoft VBScript compilation error '800a0401'
Expected end of statement
Do the following
<%
html = ""
Set cdoMessage = Server.CreateObject("CDO.Message")
cdoMessage.From = "email_from#domain.com"
cdoMessage.To = "email_to#domain.com"
cdoMessage.Bcc = "email_bcc#domain.com"
cdoMessage.Subject = "subject"
cdoMessage.ReplyTo = "email_replyto#domain.com"
cdoMessage.HTMLBody = html
sch = "http://schemas.microsoft.com/cdo/configuration/"
cdoMessage.Configuration.Fields.Item(sch & "smtpserver") = smtp.domain.com
cdoMessage.Configuration.Fields.Item(sch & "sendusername") = user
cdoMessage.Configuration.Fields.Item(sch & "sendpassword") = pass
cdoMessage.Configuration.Fields.Item(sch & "smtpserverport") = 587
cdoMessage.Configuration.Fields.Item(sch & "smtpusessl") = False
cdoMessage.Configuration.Fields.Item(sch & "smtpconnectiontimeout") = 60
cdoMessage.Configuration.Fields.Item(sch & "smtpauthenticate") = 1
cdoMessage.Configuration.Fields.Item(sch & "sendusing") = 2
cdoMessage.Configuration.Fields.update
cdoMessage.Send
Set cdoMessage = Nothing
%>
The problem is the extra quotation marks, try this:
ObjSendMail.HTMLBody = "<h2 align=center><a href='example.co.uk/Uploaded_Files/" & Request.Form("filenamex") & "'>View File</a>"
Related
I keep receiving an object required error on line 32 for "oFileCollection" and am unsure if the cause of the problem is the function not receiving the information from the Case or if the function needs to have the whole argument and code inside of it in order to retrieve the information.
Option Explicit
Dim sDirectoryPath,Search_Days,iDaysOld,CmdArg_Object,lastModDate
Dim oFSO,oFolder,oFileCollection,oFile,oTF, SubFolder
'------------------------------------------------------
Set CmdArg_Object = Wscript.Arguments
Select Case (CmdArg_Object.Count)
Case 2
sDirectoryPath = CmdArg_Object.item(0)
Search_Days = CmdArg_Object.item(1)
Case Else
WScript.Echo "SearchFiles.vbs requires 2 parameters:" &_
vbcrlf & "1) Folder Path" &_
vbcrlf & "2) # Days to Search"
WScript.Quit
End Select
Set oFSO = CreateObject("Scripting.FileSystemObject")
iDaysOld=Date+(-1*Search_Days)
Set oTF = oFSO.CreateTextFile("C:\Old Files.txt")
WScript.Echo Now & " - Beginning " & Search_Days & " day search of " & sDirectoryPath
TraverseFolders oFSO.GetFolder(sDirectoryPath)
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.Files
Function TraverseFolders (FolderName)
Set SubFolder = oFileCollection
For Each SubFolder In FolderName.SubFolders
TraverseFolders (SubFolder)
Next
For Each oFile In SubFolder.Files
lastModDate = oFile.DateLastModified
If (lastModDate <= iDaysOld) Then
oTF.WriteLine (oFile.Path)
oTF.WriteLine (oFile.DateLastModified)
oTF.WriteLine ("-----------------------")
End If
Next
End Function
WScript.Echo "Now - Finished"
Here's my quite old example; posted as is unchanged…
Function ShowFolderListPlus analyzes supplied folder and calls itself recursively for all subfolders.
option explicit
Dim MyFolder, MyAgeLimitInDays, objFSO, numDateDiff, sResult
MyFolder = "C:\testC"
MyAgeLimitInDays = 365
sResult = ""
Set objFSO = CreateObject( "Scripting.FileSystemObject")
ShowFolderListPlus( MyFolder)
WScript.Echo "Testing files older/newer than " & Cstr( MyAgeLimitInDays) _
& " days:" & vbNewLine & sResult
WScript.Quit
Function ShowFolderListPlus( FolderToAnalyse)
Dim objFolder, itemFile, itemFldr, colFileList, colSubFldr, parFolder, sc, sa
sa = String( DepthOfPath( FolderToAnalyse), "-")
sc = FolderToAnalyse & " " & sa & vbNewLine
Set objFolder = objFSO.GetFolder( FolderToAnalyse)
Set colFileList = objFolder.Files
For Each itemFile in colFileList
If StrComp( Right( itemFile.name, 4), ".bat", vbTextCompare) = 0 Then
'exclude files of specified extension'
Else
numDateDiff = DateDiff("d", itemFile.DateCreated, now)
If numDateDiff > MyAgeLimitInDays Then
sc = sc & sa & "old "
'''-------------------------------'''
''' objFSO.DeleteFile( itemFile) ''' delete file older than limit
'''-------------------------------'''
Else
sc = sc & sa & "new "
End If
sc = sc & itemFile.name & " " & numDateDiff & vbNewLine
End If
Next
Set colSubFldr = objFolder.SubFolders
For Each itemFldr in colSubFldr
parFolder = FolderToAnalyse & "\" & itemFldr.name
ShowFolderListPlus( parFolder) 'calls the procedure itself recursively'
Next
sResult = sc & sResult
ShowFolderListPlus = sc
End Function
Function DepthOfPath( strPth)
Dim AuxArray
AuxArray = Split( strPth, "\", -1, vbTextCompare)
DepthOfPath = UBound( AuxArray)
End Function
Output sample:
==> cscript D:\VB_scripts\Oldies\Folders\filescolection_in_subfolders.vbs
Testing files older/newer than 365 days:
C:\testC -
-old bar.txt 777
-old foo.txt 777
C:\testC\NewFolder21 --
--old NewTextFile1 1289
--new NewTextFile2 162
C:\testC\a --
C:\testC\43381802 --
--old MailCliеnt.txt 582
--old q44554519.html 538
C:\testC\43381802\bubu ---
---new 3-3-2018-.png 277
---old NewTextDocument.txt 1146
---old output.txt 1146
I am trying to integrate HP Application Lifecycle Management (HP ALM) with Robot Framework using VAPI-XP tool inside HP ALM. I want to know whether anyone of you have tried this before, and if so please share your approach.
Regards,
Unni
I am posting the script (VBScript to be written inside the VAPI-XP Testscript pane) which i have created for my project to integrate Robot FW with Quality Center. This will create a dyanamic batch command line file, execute the robot framework script when the script triggered from QC and post the RF html result files as an attachment to the QC Test run instance.
You can go through the script and modify based on your need.
Thanks,
Damodharan B
' ----------------------------------------------------
' Main Test Function
' Debug - Boolean. Equals to false if running in [Test Mode] : reporting to Quality Center
' CurrentTestSet - [OTA COM Library].TestSet.
' CurrentTSTest - [OTA COM Library].TSTest.
' CurrentRun - [OTA COM Library].Run.
' ----------------------------------------------------
Sub Test_Main(Debug, CurrentTestSet, CurrentTSTest, CurrentRun)
On Error Resume Next
TDOutput.Clear
' Run Test
strMainDir = "C:\Robot-QC"
strTestDir = strMainDir & "\Execution"
strBatchFileDir = strTestDir & "\BatchFiles"
strResultDir = strTestDir & "\Results"
strTestName = "TestCase1"
strResultPath = strResultDir & "\" & strTestName & "_Res"
strExecutionLogPath = strResultPath & "\ExecutionLog.txt"
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strResultPath) Then
objFSO.DeleteFolder strResultPath, True
End If
objFSO.CreateFolder strResultPath
'If Execution Directly From QC, Creates Test Batch File
If Not objFSO.FileExist(strBatchFileDir & "\" & strTestName & ".bat")Then
'Write Batch File for Test
Set objTestBatchFile = objFSO.OpenTextFile(strBatchFileDir & "\" & strTestName & ".bat", 2, True)
objTestBatchFile.WriteLine "cd " & strTestDir
objTestBatchFile.WriteLine "pybot -t " & strTestName & " --outputdir Results\" & strTestName & "_Res " & "TestCases.txt"
objTestBatchFile.Close
Set objTestBatchFile = Nothing
End If
XTools.run strBatchFileDir & "\" & strTestName & ".bat", "", -1
XTools.Sleep 1000
' Update Run Status
strTDOutPut = Replace(TDOutput.Text, " ", "")
If InStr(1, strTDOutPut, strTestName & "|PASS|") = 0 Then
CurrentRun.Status = "Failed"
CurrentTSTest.Status = "Failed"
End If
'Log Command Prompt Output
Call Log_Output(objFSO,strExecutionLogPath)
'Upload Result Files
Set objFolder = objFSO.GetFolder(strResultPath & "\")
Set objFiles = objFolder.Files
For Each oFile In objFiles
Set objRunAttach = CurrentRun.Attachments
Set newAtt = objRunAttach.AddItem(Null)
newAtt.FileName = strResultPath & "\" & oFile.Name
newAtt.Type = 1
newAtt.Post
newAtt.Refresh
Next
Set newAtt = Nothing
Set objRunAttach = Nothing
Set objFiles = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
Err.Clear
On Error Goto 0
End Sub
Sub Log_Output(objFSO,strExecutionLogPath)
Set objOutputFile = objFSO.OpenTextFile(strExecutionLogPath, 2, True)
objOutputFile.Write TDOutput.Text
objOutputFile.Close
Set objOutputFile = Nothing
End Sub
I want is after i login i want to change my label.text in my home.aspx
what is should i do
.
Problems in VB.net than ASP.net
Always i do is
Home.aspx.label.text = userTxt.text
But on this asp i got a problem on that
If userTxt.Text <> "" And passTxt.Text <> "" Then
cmd = New OleDbCommand("Select * from loginClient where emailaddress = '" & userTxt.Text & "' and password = '" & passTxt.Text & "'", cnn)
rdoleb = cmd.ExecuteReader
Response.Redirect("main.aspx")
rdoleb.Close()
If rdoleb.Read = True Then
If userTxt.Text = rdoleb.Item(2) And passTxt.Text = rdoleb.Item(3) Then
rdoleb.Close()
End If
My form takes me to an internal error page upon submission. I have all the fields defined, and my SMTP info passing through. It looks as if everything should work. But it simply doesn't.
Any suggestions is appreciated.
<%
'Declaring Variables
Dim smtpserver,youremail,yourpassword,ContactUs_Name,ContactUs_Email
Dim ContactUs_Subject,ContactUs_Body,Action,IsError
' Edit these 3 values accordingly
smtpserver = "mysmtperserver"
youremail = "myemail"
yourpassword = "mypassword"
' Grabbing variables from the form post
ContactUs_Name = Server.HTMLEncode(Request("ContactUs_Name"))
ContactUs_Email = Server.HTMLEncode(Request("ContactUs_Email"))
ContactUs_Subject = Server.HTMLEncode(Request("ContactUs_Subject"))
ContactUs_Body = Server.HTMLEncode(Request("ContactUs_Body"))
ContactUs_Captcha = Request("recaptcha_response_field")
Action = Request("Action")
' Used to check that the email entered is in a valid format
Function IsValidEmail(Email)
Dim ValidFlag,BadFlag,atCount,atLoop,SpecialFlag,UserName,DomainName,atChr,tAry1
ValidFlag = False
If (Email <> "") And (InStr(1, Email, "#") > 0) And (InStr(1, Email, ".") > 0) Then
atCount = 0
SpecialFlag = False
For atLoop = 1 To Len(Email)
atChr = Mid(Email, atLoop, 1)
If atChr = "#" Then atCount = atCount + 1
If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True
If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True
If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True
If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True
Next
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "#")
UserName = tAry1(0)
DomainName = tAry1(1)
If (UserName = "") Or (DomainName = "") Then BadFlag = True
If Mid(DomainName, 1, 1) = "." then BadFlag = True
If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True
ValidFlag = True
End If
End If
If BadFlag = True Then ValidFlag = False
IsValidEmail = ValidFlag
End Function
%>
<%
If Action = "SendEmail" Then
' Here we quickly check/validate the information entered
' These checks could easily be improved to look for more things
If IsValidEmail(ContactUs_Email) = "False" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter valid Email address.</font><br>")
End If
If ContactUs_Name = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter your Name.</font><br>")
End If
If ContactUs_Subject = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please enter a Subject.</font><br>")
End If
If ContactUs_Body = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Please include Message.</font><br>")
End If
if ContactUs_Captcha = "" Then
IsError = "Yes"
Response.Write("<font color=""red"">Captcha Required.</font><br>")
End If
End If
' If there were no input errors and the action of the form is "SendEMail" we send the email off
If Action = "SendEmail" And IsError <> "Yes" Then
Dim strBody
' Here we create a nice looking html body for the email
strBody = strBody & "<font face=""Arial"">Contact Us Form submitted at " & Now() & vbCrLf & "<br><br>"
strBody = strBody & "From http://" & Request.ServerVariables("HTTP_HOST") & vbCrLf & "<br>"
strBody = strBody & "IP " & Request.ServerVariables("REMOTE_ADDR") & vbCrLf & "<br>"
strBody = strBody & "Name" & " : " & " " & Replace(ContactUs_Name,vbCr,"<br>") & "<br>"
strBody = strBody & "Email" & " : " & " " & Replace(ContactUs_Email,vbCr,"<br>") & "<br>"
strBody = strBody & "Subject" & " : " & " " & Replace(ContactUs_Subject,vbCr,"<br>") & "<br>"
strBody = strBody & "<br>" & Replace(ContactUs_Body,vbCr,"<br>") & "<br>"
strBody = strBody & "</font>"
Dim ObjSendMail
Set ObjSendMail = CreateObject("CDO.Message")
'This section provides the configuration information for the remote SMTP server.
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 'Send the message using the network (SMTP over the network).
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = smtpserver
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = False 'Use SSL for the connection (True or False)
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 'basic (clear-text) authentication
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusername") = youremail
ObjSendMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = yourpassword
ObjSendMail.Configuration.Fields.Update
'End remote SMTP server configuration section==
ObjSendMail.To = youremail
ObjSendMail.Subject = ContactUs_Subject
ObjSendMail.From = ContactUs_Email
' we are sending a html email.. simply switch the comments around to send a text email instead
ObjSendMail.HTMLBody = strBody
'ObjSendMail.TextBody = strBody
ObjSendMail.Send
Set ObjSendMail = Nothing
' change the success messages below to say or do whatever you like
' you could do a response.redirect or offer a hyperlink somewhere.. etc etc
%>
If you can't do much with custom error pages then you can use "On Error Resume Next" to trap errors, something like:
On Error Resume Next
'Put your code in here
'Write out error messages
If err.number > 0 then
response.write "Error: err.description & " on line number <strong>" & err.line & "</strong>"
END IF
On Error Goto 0
Caveat: I'd just recommend taking this out once you've got your code working as can mask issues if not used carefully. Instead look at getting some proper error handling and logging in place using custom error pages.
Just at a quick glance... this section looks to be missing an END IF
If (atCount = 1) And (SpecialFlag = False) Then
BadFlag = False
tAry1 = Split(Email, "#")
UserName = tAry1(0)
DomainName = tAry1(1)
I'm using this with my server to send mails. Which is working perfectly.I want to try it out on my localhost app that I made.
Set myMail=CreateObject("CDO.Message")
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/bodyformat") = 0 ' 0 - html, 1 - text
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/mailformat") = 0 ' 0 - mime, 1 - text
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "206.183.108.132"
myMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
myMail.Configuration.Fields.Update
myMail.Subject = "Your New Password for Leave App"
myMail.From = rs("email")
myMail.To = "somename#domain.com"
msgg = msgg & "Dear" & " " & session("Username") & vbcrlf & vbcrlf
msgg = msgg & "This is your new password" & vbcrlf & vbcrlf
msgg = msgg & "YOUR CHANGED PASSWORD" & vbcrlf
msgg = msgg & "- - - - - - - - - - - - - - - - - - - - - - - - - - -" & vbcrlf
msgg = msgg & "User/Login Name :" & session("Username") & vbcrlf
msgg = msgg & "Password :" & request.Form("new_pass2") & vbcrlf
msgg = msgg & "- - - - - - - - - - - - - - - - - - - - - - - - - - -" & vbcrlf & vbcrlf
msgg = msgg & "Please sign in to your account using the user name and password above." & vbcrlf & vbcrlf
msgg = msgg & "Thanks" & vbcrlf
myMail.TextBody = msgg
myMail.Send
set myMail = nothing
Check if your local Machine can reach the SMTP server. It might be blocked in some firewall or router. This website can perform a simple check for you: http://www.canyouseeme.org/
Of course, you might want to check it in the code as well, or via Telnet: http://www.simplescripts.de/smtp-check-port-25-telnet-command.htm
Here is the contents of an include file I created for sending emails:
[note at the top it includes another include that has a fn_dirty() for the purpose of adding things like quotes back in.] ask me if you want that function.
<!-- #INCLUDE FILE = "i_fn_dirty.asp" -->
<%
function email(s_name_from,s_address_from,s_reply_to,s_subject,s_recipients_list,s_msg,s_type_email,s_msg_error_add,s_RemoteHost)
if (s_msg_error_add<>"") then s_msg_error_add = "<hr>" & vbCrLf & s_msg_error_add
if (s_RemoteHost="default") then s_RemoteHost = application("s_mail_server")
'recipients_list = "Scott,scott#changed.net;Andy,andy#changed.net" etc
array_recipients = split(s_recipients_list,";",-1,1)
'so recipients array now looks like this:
'array_recipients(0) = "Scott,scott#changed.net"
'array_recipients(1) = "Andy,andy#changed.net"
'-- Create the Mailer Object
Set Mailer = Server.CreateObject("SoftArtisans.SMTPMail")
'-- Set the Mail Properties
Mailer.RemoteHost = s_RemoteHost
Mailer.FromName = s_name_from
Mailer.FromAddress = s_address_from
if (s_reply_to<>"") then Mailer.ReplyTo = s_reply_to
Mailer.Subject = s_subject
a = ""
For Each Item in array_recipients
array_data = split(Item,",",-1,1)
s_name = array_data(0)
s_email_addr = array_data(1)
if (s_name<>"" and s_email_addr<>"") then
Mailer.AddRecipient s_name, s_email_addr
a = a & "name: " & s_name & ", email: " & s_email_addr & " | "
end if
Next
if (s_type_email = "text") then
Mailer.BodyText = s_msg
else
s_msg_html = replace(s_msg,vbCrLf,"<br>",1,-1,1)
Mailer.HTMLText = s_msg_html
end if
'-- Fire off the email message
if (Mailer.SendMail) then
'yay it worked
Set Mailer = Nothing
else
'try one more time
if (Mailer.SendMail) then
'yay it worked
Set Mailer = Nothing
else
msg = "<br>Error in i_fn_email.asp: " & Mailer.Response & "<br>"
msg = msg & "s_name_from = " & s_name_from & "<br>"
msg = msg & "s_address_from = " & s_address_from & "<br>"
msg = msg & "s_subject = " & s_subject & "<br>"
msg = msg & "recips list = " & a & "<br>"
msg = msg & s_msg_error_add
session("msg") = msg
Set Mailer = Nothing
response.redirect ("error_report.asp")
end if
end if
end function
%>