e-mail results from a survey or form in Lectora

Below is a script that will both email test and surveys. It also allows you to change the subject line and from addresses based on whether it's a survey to test.

<%@ Language=VBScript %>
<%
'Get the parameters posted from the test'
 testname=Request.form("TestName")
 surveyname=Request.form("SurveyName")
 score=Request.form("Score")
 user=Request.form("name")
 numQuestions=Request.form("NumQuestions")
 passingGrade=Request.form("PassingGrade")
 strbody=""
 subjectline=""
 fromaddress=""

 if len(surveyname)>0 then score="NA"
 if len(surveyname)>0 then passingGrade="NA"
 if len(surveyname)>0 then testname=surveyname

'Validate that this is actually from a Lectora test'
 if testname="" Or score="" Or user="" Or numQuestions="" Or passingGrade="" then

Response.Write ""
Response.Write "Failure"
Response.Write ""
Response.Write "STATUS=501"
Response.Write "
"
Response.Write "Could not parse test results due to a parameter error."
Response.Write ""
 else

'Write the results'
strbody = strbody & "Date: " & Date & ", " & Time & "
"
strbody = strbody & "Name: " & Replace(user,"%20"," ") & "
"
if len(surveyname)>0 then
strbody = strbody & "Survey: " & testname & "
"
else
strbody = strbody & "Test: " & testname & "
"
end if

strbody = strbody & "Score: " & score & "

"

'Older courses produced by Lectora used a zero based index for the questions (i.e. Question0 is the first question)' 'Newer courses are one based (i.e. Question1 is the first question)'
'determine which one it is'
Dim startIndex
valTemp = Request.form("Question0")
if( valTemp="" ) then
startIndex=1
else
startIndex=0
end if

'Write all of the questions and answers'
for i = startIndex to cint(startIndex + numQuestions-1)
nameQ = "Question" + CStr(i)
nameA = "Answer" + CStr(i)
valQ = Request.form(nameQ)
valA = Request.form(nameA)
strbody= strbody & nameQ &": " & valQ & "
"
strbody= strbody & nameA & ": " & valA & "

"
Next

strbody = strbody & ""

'Create Subject Line'
if len(surveyname)>0 then
subjectline = "Survey: " & testname &", User:"& Replace(user,"%20"," ")
else
subjectline = "Test: " & testname &", User:"& Replace(user,"%20"," ")
end if

'Create From Address'
if len(surveyname)>0 then
fromaddress="surveyresults@domain.com"
else
fromaddress="testresults@domain.com"
end if

'Send the Email'
Set objMessage = CreateObject("CDO.Message")
With objMessage
Set Header = .Fields
With Header
.Item("urn:schemas:mailheader:X-Mailer") = "Html Mailer"
.Item("urn:schemas:mailheader:Content-Type") = "text/html; charset=us-ascii"
.Item("urn:schemas:mailheader:Content-Transfer-Encoding") = "7bit"
.Update
End With
end with

objMessage.Subject = subjectline
objMessage.From = fromaddress
objMessage.To = "testresults@domain.com"
objMessage.TextBody = "This is an HTML Email"
objMessage.HTMLBody = strbody

'==This section provides the configuration information for the remote SMTP server.
'==Normally you will only change the server name or IP.
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Name or IP of Remote SMTP Server'
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.3.23"

'Server port (typically 25)'
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objMessage.Configuration.Fields.Update

'==End remote SMTP server configuration section=='
objMessage.Send
 end if
%>