Corcent
asked on
ASP Error - 800a0e78 - Operation is not allowed when the object is closed.
This page previously worked but now is throwing an error, the error is:
ADODB.Recordset error '800a0e78'
Operation is not allowed when the object is closed.
/surveys/SurveyResults.asp , line 828
URL to which is throwing the error:
http://www.focus3.biz/surveys/SurveyResults.asp?SurveyID=6LI5633I39m4M&UserID=6LI564L039m4M
Code from SurveyResults.asp page
ADODB.Recordset error '800a0e78'
Operation is not allowed when the object is closed.
/surveys/SurveyResults.asp
URL to which is throwing the error:
http://www.focus3.biz/surveys/SurveyResults.asp?SurveyID=6LI5633I39m4M&UserID=6LI564L039m4M
Code from SurveyResults.asp page
<!--#Include File="Include/Config_inc.asp"-->
<!--#Include File="Include/SurveyUtility_inc.asp"-->
<!--#Include File="Include/Utility_inc.asp"-->
<!--#Include File="Include/adovbs_inc.asp"-->
<!--#Include File="Include/CurrentUser_inc.asp"-->
<!--#Include File="Include/Constants_inc.asp"-->
<!--#Include File="Include/Collection_inc.asp"-->
<!--#Include File="Include/SurveySecurity_inc.asp"-->
<!--#Include File="Include/ReportShare_inc.asp"-->
<!--#Include File="Include/SurveyReportFilter_inc.asp"-->
<!--#Include File="Include/Encryption_inc.asp"-->
<%
Dim strBody
'If the report share security ID is being passed to the page, save it and get the survey ID from it. Otherwise,
'if there is a report share security in session, extract the survey ID from that. Finally, if neither of those cases
'is valid, extract the survey ID from the querystring.
If Len(Request.QueryString("SID")) > 0 Then
lngSurveyID = CreateReportShareSessionString(Request.QueryString("SID"))
'If report sharing is disabled for this survey, redirect to the access denied page
If IsReportSharingEnabled(lngSurveyID) = False Then
Response.Redirect "AccessDenied.asp?SurveyID=" & lngSurveyID & "&Reason=" & SUR_ACCESS_DENIED_REPORT_SHARING_DISABLED
End If
ElseIf Len(Session(SUR_REPORT_SHARE_SESSION_STRING)) > 0 Then
'Get the survey ID from the report sharing session information
lngSurveyID = CLng(GetValueFromReportShareSessionString(SUR_REPORT_SHARE_FIELD_SURVEY_ID))
Else
lngSurveyID = DecryptSurveyID(Request.QueryString("SurveyID"))
End If
Dim lngUserID
If (Request.QueryString("UserID") <> "") Then
lngUserID = DecryptSurveyID(Request.QueryString("UserID"))
End If
'If the viewable reports are none because the share is inactive, redirect to the access denied page with an
'appropriate error.
If GetValueFromReportShareSessionString(SUR_REPORT_SHARE_FIELD_VIEWABLE_REPORTS) = SUR_VIEWABLE_REPORT_NONE Then
Response.Redirect "AccessDenied.asp?SurveyID=" & lngSurveyID & "&Reason=" & SUR_ACCESS_DENIED_REPORT_SHARE_INACTIVE
End If
Dim strSQL
Dim lngSurveyID
Dim lngQuestionNumber
Dim strItemText
Dim i
Dim lngItemID
Dim lngItemTypeID
Dim strOtherText
Dim lngTextResponseCount
Dim strAnswersCollection
Dim strUniqueRespondentsPerAnswerCollection
Dim strAnswerIDsCollection
Dim rsSurvey
Dim rsQuestions
Dim rsAnswers
Dim strTemp
Dim rsSubItems
Dim rsDisplayFilter
Dim rsUserName
Dim lngResponseCount
Dim vaAnswers
Dim flgOther
Dim strTitle
Dim lngTotalRespondents
Dim lngFilteredRespondents
Dim lngSkippedTotal
Dim lngColspanCount
Dim lngNumberTotal
Dim lngAnswerCount
Dim lngCurrentResponseID
Dim lngCurrentSubItemID
Dim lngRowTotal
Dim lngRowAverage
Dim lngBeginningNumber
Dim lngEndingNumber
Dim lngPercentage
Dim lngHighestAverage
Dim lngTemp
Dim strReportFilters
Dim strQuestionNumberingFormat
Dim lngCurrentItemNumber
Dim strSelected
Dim strItemAlias
Dim lngReportFilterCount
Dim lngUniqueRespondentCount
Dim lngTotalPoints
Dim flgHighlightResponses
Dim rsHighlightResponses
Dim strHighlightResponses
Dim lngResponseID
Dim strUserName
'Initialization
Set rsSurvey = Server.CreateObject("ADODB.Recordset")
Set rsSubItems = Server.CreateObject("ADODB.Recordset")
Set rsQuestions = Server.CreateObject("ADODB.Recordset")
Set rsAnswers = Server.CreateObject("ADODB.Recordset")
Set rsDisplayFilter = Server.CreateObject("ADODB.Recordset")
Set rsUserName = Server.CreateObject("ADODB.Recordset")
lngQuestionNumber = 1
strSQL = "SELECT username FROM sur_user WHERE user_id=" & lngUserID & ";"
rsUserName.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenDynamic, , adCmdText
strUserName = rsUsername("username")
rsUserName.Close
'Get general information about the survey
strSQL = "SELECT title, response_count, question_numbering_format, launched_date, closed_date, " & _
"status, highlight_responses_yn, report_sharing_enabled_yn " & _
"FROM sur_survey " & _
"WHERE survey_id = " & lngSurveyID
rsSurvey.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenDynamic, , adCmdText
rsSurvey.MoveFirst
strTitle = rsSurvey("title")
lngTotalRespondents = CLng(rsSurvey("response_count")) - 1
lngFilteredRespondents = GetFilteredRespondentCount(lngSurveyID) - 1
strQuestionNumberingFormat = rsSurvey("question_numbering_format")
'If the user's responses should be highlighted, check to see if the user has taken the survey. If so,
'select all of the user's responses.
If rsSurvey("highlight_responses_yn") = SUR_BOOLEAN_POSITIVE Then
'Get the response ID for this user from the cookie
lngResponseID = Request.Cookies(SUR_APPLICATION_COOKIE)(SUR_COOKIE_SURVEY & Request.ServerVariables("REMOTE_ADDR") & lngSurveyID)
'If there is no response ID, do not highlight responses
If Len(lngResponseID) = 0 Then
flgHighlightResponses = False
Else
flgHighlightResponses = True
'Create a recordset of the responses for this user's response
Set rsHighlightResponses = Server.CreateObject("ADODB.Recordset")
strSQL = "SELECT answer_id, subitem_id, item_id, answer_text, other_text " & _
"FROM sur_response_answer " & _
"WHERE response_id = " & lngResponseID
rsHighlightResponses.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenDynamic, , adCmdText
'Create a string with all of the user's responses in it. This string is used for comparisons later on.
strHighlightResponses = "|"
If Not rsHighlightResponses.EOF Then
Do While Not rsHighlightResponses.EOF
If Len(rsHighlightResponses("answer_id")) > 0 And IsNull(rsHighlightResponses("answer_id")) = False And rsHighlightResponses("answer_id") > 0 Then
strTemp = strTemp & "AnswerID" & rsHighlightResponses("answer_id")
End If
If Len(rsHighlightResponses("subitem_id")) > 0 And IsNull(rsHighlightResponses("subitem_id")) = False And rsHighlightResponses("subitem_id") > 0 Then
strTemp = strTemp & "SubItemID" & rsHighlightResponses("subitem_id")
End If
If rsHighlightResponses("answer_text") = SUR_ANSWER_TEXT_OTHER_SELECTED Then
strTemp = strTemp & "ItemID" & rsHighlightResponses("item_id") & SUR_ANSWER_TEXT_OTHER_SELECTED
Else
If rsHighlightResponses("answer_text") <> SUR_ANSWER_TEXT_NULL Then
strTemp = strTemp & "ItemID" & rsHighlightResponses("item_id") & rsHighlightResponses("answer_text")
End If
End If
strHighlightResponses = strHighlightResponses & strTemp & "|"
strTemp = ""
rsHighlightResponses.MoveNext
Loop
End If
'Clean up
rsHighlightResponses.Close
Set rsHighlightResponses = Nothing
End If
Else
flgHighlightResponses = False
End If
strBody = strBody & "<html>"
strBody = strBody & "<head>"
strBody = strBody & "<STYLE type='text/css'>"
'strBody = strBody & "td { font-family:Arial;font-size:13px; }"
strBody = strBody & "table, td { border-color: black;border-style: solid;font-family:Arial;font-size:13px; }" & vbCrLf
strBody = strBody & "table {border-width: 0 0 1px 1px;border-spacing: 0;border-collapse: collapse;}" & vbCrLf
strBody = strBody & "td {margin: 0;padding: 4px;border-width: 1px 1px 0 0;background-color: white;}" & vbCrLf
strBody = strBody & "</style>"
strBody = strBody & "</head>"
strBody = strBody & "<body>"
'strBody = strBody & "<table style='border:solid 1px black;width:100%'>"
strBody = strBody & "<table>"
strBody = strBody & "<tr>"
strBody = strBody & "<td colspan='9'><center><b>" & strTitle & "</b></center></td>"
strBody = strBody & "</tr>"
strBody = strBody & "<tr>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:2%;'> </td>"
strBody = strBody & "<td style='background-color:#C0C0C0'> </td>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:8%' align='center'><b>1</b></td>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:8%' align='center'><b>2</b></td>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:8%' align='center'><b>3</b></td>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:8%' align='center'><b>4</b></td>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:8%' align='center'><b>5</b></td>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:3%'> </td>"
strBody = strBody & "<td style='background-color:#C0C0C0;width:8%;'> </td>"
strBody = strBody & "</tr>"
strBody = strBody & "<tr>"
strBody = strBody & "<td> </td>"
strBody = strBody & "<td> </td>"
strBody = strBody & "<td align='center' valign='bottom'><b>Needs<br />Significant<br />Improvement</b></td>"
strBody = strBody & "<td align='center' valign='bottom'><b>Needs<br />Improvement</b></td>"
strBody = strBody & "<td align='center' valign='bottom'><b>Just OK</b></td>"
strBody = strBody & "<td align='center' valign='bottom'><b>Effective</b></td>"
strBody = strBody & "<td align='center' valign='bottom'><b>Exceptional</b></td>"
strBody = strBody & "<td align='center' valign='bottom'><b>Avg.</b></td>"
strBody = strBody & "<td align='center' valign='bottom'><b># of<br />Responses</b></td>"
strBody = strBody & "</tr>"
'Get all of the answers for the survey
strSQL = "SELECT ra.response_id, ra.subitem_id, m.item_id AS item_id, ra.answer_id AS ResponseAnswerID, " & _
"ia.answer_value, ra.answer_text AS ResponseAnswerText, ra.other_text AS ResponseOtherText " & _
"FROM sur_survey_to_item_mapping m INNER JOIN (sur_response_answer ra LEFT JOIN sur_item_answer ia " & _
"ON ra.answer_id = ia.answer_id) ON m.item_id = ra.item_id " & _
"WHERE m.item_id = ra.item_id "
'If the user selected a filter other than display all, filter the answers
If Len(Request.Form("cboDisplay")) > 0 And Request.Form("cboDisplay") <> "All" Then
'If the user selected a page, filter on the page
If InStr(Request.Form("cboDisplay"), "PAGE") > 0 Then
strSQL = strSQL & " AND m.page_number = " & Mid(Request.Form("cboDisplay"), InStr(Request.Form("cboDisplay"), "PAGE") + 4, Len(Request.Form("cboDisplay")) - (InStr(Request.Form("cboDisplay"), "PAGE") - 3))
End If
'If the user selected a question, display only that question
If InStr(Request.Form("cboDisplay"), "ITEMID") > 0 Then
strSQL = strSQL & " AND m.item_id = " & Mid(Request.Form("cboDisplay"), InStr(Request.Form("cboDisplay"), "ITEMID") + 6, Len(Request.Form("cboDisplay")) - (InStr(Request.Form("cboDisplay"), "ITEMID") - 5))
End If
End If
'If there are report filters, display only the data from questions that match the filter criteria
'strReportFilters = GetFilteredResponseList(lngSurveyID)
'If CStr(strReportFilters) <> SUR_REPORT_FILTER_NO_ACTIVE_FILTERS Then
strSQL = strSQL & " AND response_id IN(SELECT response_id FROM sur_response WHERE survey_id=" & lngSurveyID & " AND username <> '" & strUserName & "' AND user_id=" & lngUserID & ")"
'End If
'Complete the SQL statement and open the recordset
strSQL = strSQL & " AND m.survey_id = " & lngSurveyID & _
" ORDER BY m.order_number, ra.response_id"
rsAnswers.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenDynamic, , adCmdText
'Check to see if there are any results; if not, display a message indicating that there are no results
If rsAnswers.EOF = True Then
' Response.end
End If
'Get all of the questions for the survey. This query selects only the items associated with the survey that are
'actually questions. This particular SQL statement uses ANSI-standard SQL with "INNER JOIN" and "LEFT JOIN" syntax
'so that it will work against both Access and SQL Server.
strSQL = "SELECT minimum_value, maximum_value, sur_item.item_id As item_id, " & _
"sur_item.item_type_id As item_type_id, other_yn, " & _
"answer_id, sur_item_answer.answer_text As ItemAnswerText, other_text, item_alias, item_text " & _
"FROM ((sur_item INNER JOIN sur_survey_to_item_mapping " & _
"ON sur_item.item_id = sur_survey_to_item_mapping.item_id) " & _
"INNER JOIN sur_item_type " & _
"ON sur_item.item_type_id = sur_item_type.item_type_id) " & _
"LEFT JOIN sur_item_answer ON sur_item.item_id = sur_item_answer.item_id " & _
"WHERE question_yn = " & SQLEncode(SUR_BOOLEAN_POSITIVE)
'If the user selected a filter other than display all, filter the answers
If Len(Request.Form("cboDisplay")) > 0 And Request.Form("cboDisplay") <> "All" Then
'If the user selected a page, filter on the page
If InStr(Request.Form("cboDisplay"), "PAGE") > 0 Then
strSQL = strSQL & " AND sur_survey_to_item_mapping.page_number = " & Mid(Request.Form("cboDisplay"), InStr(Request.Form("cboDisplay"), "PAGE") + 4, Len(Request.Form("cboDisplay")) - (InStr(Request.Form("cboDisplay"), "PAGE") - 3))
End If
'If the user selected a question, display only that question
If InStr(Request.Form("cboDisplay"), "ITEMID") > 0 Then
strSQL = strSQL & " AND sur_item.item_id = " & Mid(Request.Form("cboDisplay"), InStr(Request.Form("cboDisplay"), "ITEMID") + 6, Len(Request.Form("cboDisplay")) - (InStr(Request.Form("cboDisplay"), "ITEMID") - 5))
End If
End If
'Complete the SQL statement and open the recordset
strSQL = strSQL & " AND sur_survey_to_item_mapping.survey_id = " & lngSurveyID & _
" ORDER BY sur_survey_to_item_mapping.order_number, sur_item_answer.order_number"
rsQuestions.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenDynamic, , adCmdText
'Loop through the questions, calculating the the number of responses for each answer.
Do While Not rsQuestions.EOF
'If a question alias was supplied, use that instead of the question. Otherwise, use
'the actual question text.
strItemText = Trim(rsQuestions("item_text"))
strItemAlias = RemoveLineFeeds(Trim(rsQuestions("item_alias")))
If Len(strItemAlias) > 0 Then
strItemText = strItemAlias
End If
strItemText = RemovePipeTokens(strItemText)
'Initialization for each question
lngItemID = rsQuestions("item_id")
lngItemTypeID = rsQuestions("item_type_id")
flgOther = rsQuestions("other_yn")
strOtherText = rsQuestions("other_text")
strAnswersCollection = ""
strAnswerIDsCollection = ""
strUniqueRespondentsPerAnswerCollection = ""
lngResponseCount = 0
lngSkippedTotal = 0
lngAnswerCount = 0
lngCurrentResponseID = -1
lngCurrentSubItemID = -1
lngCurrentResponseID = -1
lngUniqueRespondentCount = 0
lngTotalPoints = 0
'If the current question has subitems, query to obtain the list of subitems
If lngItemTypeID = SUR_ITEM_CONSTANT_SUM Or lngItemTypeID = SUR_ITEM_RANKING Or lngItemTypeID = SUR_ITEM_MATRIX_SINGLE_SELECT_OPTIONS Or lngItemTypeID = SUR_ITEM_MATRIX_RATING_SCALE Or lngItemTypeID = SUR_ITEM_MATRIX_MULTISELECT_CHECKBOXES Or lngItemTypeID = SUR_ITEM_MATRIX_TEXT_BOXES Or lngItemTypeID = SUR_ITEM_OPEN_ENDED_ONE_OR_MORE_LINES Then
strSQL = "SELECT subitem_id, subitem_text " & _
"FROM sur_subitem " & _
"WHERE item_id = " & lngItemID & _
" ORDER BY order_number"
rsSubItems.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenDynamic, , adCmdText
End If
'Depending on the type of question, process the results differently
If lngItemTypeID = SUR_ITEM_MULTISELECT_CHECKBOXES Or lngItemTypeID = SUR_ITEM_SINGLE_SELECT_DROPDOWN Or lngItemTypeID = SUR_ITEM_SINGLE_SELECT_DROPDOWN_NON_QUESTION Or lngItemTypeID = SUR_ITEM_SINGLE_SELECT_OPTIONS Then 'Radio buttons, checkboxes, dropdown
'Build a string of name/value pairs by looping through the question recordset (which also has pre-defined answers).
'This string is logically a collection of name/value pairs separated by semi-colons (;) in the format
'Vanilla;6;Chocolate;7;Strawberry;1. This section sets the collection to values of 0 for all possible answers.
'Also create a collection of answer ID's to answer text for displaying the results.
Do While lngItemID = rsQuestions("item_id")
'When adding each possible answer to the collection, initialize to 0
strAnswersCollection = strAnswersCollection & rsQuestions("answer_id") & ";0;"
'Add all of the ID/Value pairs to another collection for display purposes later
strAnswerIDsCollection = strAnswerIDsCollection & rsQuestions("answer_id") & ";" & rsQuestions("ItemAnswerText") &";"
rsQuestions.MoveNext
If rsQuestions.EOF = True Then
Exit Do
End If
Loop
'Add one more name/value pair to the collection for null answers.
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_NULL & ";0;"
'If the question has an "Other" answer, add another name/value pair to the collection for "Other" responses.
If flgOther = SUR_BOOLEAN_POSITIVE Then
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_OTHER_SELECTED & ";0;"
End If
'Call a function that strips off all extra semi-colons
strAnswersCollection = CleanAnswersCollection(strAnswersCollection)
strAnswerIDsCollection = CleanAnswersCollection(strAnswerIDsCollection)
'Loop through the actual answers and increment the counts for each. The counts are incremented in
'the helper function, IncrementCountInCollection
If Not rsAnswers.EOF Then
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
If lngCurrentResponseID <> rsAnswers("response_id") Then
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
lngCurrentResponseID = rsAnswers("response_id")
End If
'If the ID is NULL (-1), a text response was recorded
If CStr(rsAnswers("ResponseAnswerID")) = CStr(SUR_ANSWER_ID_NULL) Then
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, CStr(rsAnswers("ResponseAnswerText")))
Else 'An ID response was recorded
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, CStr(rsAnswers("ResponseAnswerID")))
'If there are points assigned to this item, add them up
If IsNull(rsAnswers("answer_value")) = False Then
lngTotalPoints = lngTotalPoints + CLng(rsAnswers("answer_value"))
End If
End If
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
End If
ElseIf lngItemTypeID = SUR_ITEM_YES_NO Or lngItemTypeID = SUR_ITEM_TRUE_FALSE Then
'Build a string of name/value pairs. For either Yes/No or True/False question, the values are already known,
'so there's no need to loop through the answers recordset.
'This string is logically a collection of name/value pairs separated by semi-colons (;) in the format
'Vanilla;6;Chocolate;7;Strawberry;1. This section sets the collection to values of 0 for all possible answers.
'Also create a collection of answer ID's to answer text for displaying the results.
If lngItemTypeID = SUR_ITEM_YES_NO Then
strAnswersCollection = strAnswersCollection & SUR_YES_NO_QUESTION_VALUE_YES & ";0;"
strAnswersCollection = strAnswersCollection & SUR_YES_NO_QUESTION_VALUE_NO & ";0;"
Else 'SUR_ITEM_TRUE_FALSE
strAnswersCollection = strAnswersCollection & SUR_TRUE_FALSE_QUESTION_VALUE_TRUE & ";0;"
strAnswersCollection = strAnswersCollection & SUR_TRUE_FALSE_QUESTION_VALUE_FALSE & ";0;"
End If
'Add one more name/value pair to the collection for null answers.
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_NULL & ";0;"
'Call a function that strips off all extra semi-colons
strAnswersCollection = CleanAnswersCollection(strAnswersCollection)
'Loop through the actual answers and increment the counts for each. The counts are incremented in
'the helper function, IncrementCountInCollection
If Not rsAnswers.EOF Then
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
If lngCurrentResponseID <> rsAnswers("response_id") Then
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
lngCurrentResponseID = rsAnswers("response_id")
End If
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, CStr(rsAnswers("ResponseAnswerText")))
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
End If
'Advance to the next question
rsQuestions.MoveNext
ElseIf lngItemTypeID = SUR_ITEM_CONSTANT_SUM Or lngItemTypeID = SUR_ITEM_RANKING Then
'Build a string of name/value pairs by looping through the subitem recordset.
'This string is logically a collection of name/value pairs separated by semi-colons (;) in the format
'SIDxxx;6;SIDxxx;7;SIDxxx;1, where xxx represents the subitem ID'.. This section sets the collection to values
'of 0 for all possible answers. Also create a collection of subitem ID's to subitem text for displaying
'the results.
Do While Not rsSubItems.EOF
'When adding each possible answer to the answer collection, initialize to 0
strAnswersCollection = strAnswersCollection & "SID" & rsSubItems("subitem_id") & ";0;"
'The unique respondent per answer collection starts off the same as teh answers collection
strUniqueRespondentsPerAnswerCollection = strAnswersCollection
'Add all of the ID/Value pairs to another collection for display purposes later
strAnswerIDsCollection = strAnswerIDsCollection & "SID" & rsSubItems("subitem_id") & ";" & rsSubItems("subitem_text") &";"
rsSubItems.MoveNext
Loop
'Add one more name/value pair to the collection for null answers.
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_NULL & ";0;"
'Call a function that strips off all extra semi-colons
strAnswersCollection = CleanAnswersCollection(strAnswersCollection)
strAnswerIDsCollection = CleanAnswersCollection(strAnswerIDsCollection)
strUniqueRespondentsPerAnswerCollection = CleanAnswersCollection(strUniqueRespondentsPerAnswerCollection)
'Loop through the actual answers and increment the counts for each. The counts are incremented in
'the helper function, IncrementCountInCollection
If Not rsAnswers.EOF Then
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
If lngCurrentResponseID <> rsAnswers("response_id") Then
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
lngCurrentResponseID = rsAnswers("response_id")
End If
'Increment the appropriate subitem in the collection. If the subitem_id is Null, record a non-response
If CStr(rsAnswers("ResponseAnswerText")) = CStr(SUR_ANSWER_TEXT_NULL) Then
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, SUR_ANSWER_TEXT_NULL)
Else 'An ID response was recorded
'Track the total for each answer, and the total response count for each answer. These two values
'will enable us to determine the average
strAnswersCollection = IncrementTotalInCollection(strAnswersCollection, "SID" & CStr(rsAnswers("subitem_id")), CLng(rsAnswers("ResponseAnswerText")))
strUniqueRespondentsPerAnswerCollection = IncrementCountInCollection(strUniqueRespondentsPerAnswerCollection, "SID" & CStr(rsAnswers("subitem_id")))
End If
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
End If
'Advance to the next question
rsQuestions.MoveNext
ElseIf lngItemTypeID = SUR_ITEM_OPEN_ENDED_ONE_OR_MORE_LINES Then
'Build a string of name/value pairs by looping through the subitem recordset.
'This string is logically a collection of name/value pairs separated by semi-colons (;) in the format
'SIDxxx;6;SIDxxx;7;SIDxxx;1, where xxx represents the subitem ID'.. This section sets the collection to values
'of 0 for all possible answers. Also create a collection of subitem ID's to subitem text for displaying
'the results.
Do While Not rsSubItems.EOF
'When adding each possible answer to the collection, initialize to 0
strAnswersCollection = strAnswersCollection & "SID" & rsSubItems("subitem_id") & ";0;"
'Add all of the ID/Value pairs to another collection for display purposes later
strAnswerIDsCollection = strAnswerIDsCollection & "SID" & rsSubItems("subitem_id") & ";" & rsSubItems("subitem_text") &";"
rsSubItems.MoveNext
Loop
'Add one more name/value pair to the collection for null answers.
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_NULL & ";0;"
'Call a function that strips off all extra semi-colons
strAnswersCollection = CleanAnswersCollection(strAnswersCollection)
strAnswerIDsCollection = CleanAnswersCollection(strAnswerIDsCollection)
'Loop through the actual answers and increment the counts for each. The counts are incremented in
'the helper function, IncrementCountInCollection
If Not rsAnswers.EOF Then
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
If lngCurrentResponseID <> rsAnswers("response_id") Then
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
lngCurrentResponseID = rsAnswers("response_id")
End If
'Increment the appropriate subitem in the collection. If the subitem_id is Null, record a non-response
If CStr(rsAnswers("ResponseAnswerText")) = CStr(SUR_ANSWER_TEXT_NULL) Then
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, SUR_ANSWER_TEXT_NULL)
Else 'An ID response was recorded
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, "SID" & CStr(rsAnswers("subitem_id")))
End If
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
End If
'Advance to the next question
rsQuestions.MoveNext
ElseIf lngItemTypeID = SUR_ITEM_MATRIX_TEXT_BOXES Then
'Build a string of name/value pairs by looping through the subitem recordset.
'This string is logically a collection of name/value pairs separated by semi-colons (;) in the format
'SIDxxx;6;SIDxxx;7;SIDxxx;1, where xxx represents the subitem ID'.. This section sets the collection to values
'of 0 for all possible answers. Also create a collection of subitem ID's to subitem text for displaying
'the results.
Do While Not rsSubItems.EOF
'When adding each possible answer to the collection, initialize to 0
strAnswersCollection = strAnswersCollection & "SID" & rsSubItems("subitem_id") & ";0;"
'Add all of the ID/Value pairs to another collection for display purposes later
strAnswerIDsCollection = strAnswerIDsCollection & "SID" & rsSubItems("subitem_id") & ";" & rsSubItems("subitem_text") &";"
rsSubItems.MoveNext
Loop
'Add one more name/value pair to the collection for null answers.
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_NULL & ";0;"
'Call a function that strips off all extra semi-colons
strAnswersCollection = CleanAnswersCollection(strAnswersCollection)
strAnswerIDsCollection = CleanAnswersCollection(strAnswerIDsCollection)
'Loop through the actual answers and increment the counts for each. The counts are incremented in
'the helper function, IncrementCountInCollection
If Not rsAnswers.EOF Then
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
If lngCurrentResponseID <> rsAnswers("response_id") Then
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
' lngCurrentResponseID = rsAnswers("response_id")
End If
'Increment the appropriate subitem in the collection. If the subitem_id is Null, record a non-response
If CStr(rsAnswers("ResponseAnswerID")) = CStr(SUR_ANSWER_ID_NULL) Then
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, SUR_ANSWER_TEXT_NULL)
Else 'An ID response was recorded
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, "SID" & CStr(rsAnswers("subitem_id")))
End If
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
End If
'Advance to the next question
lngItemID = rsQuestions("item_id")
Do While lngItemID = rsQuestions("item_id")
rsQuestions.MoveNext
If rsQuestions.EOF = True Then
Exit Do
End If
Loop
ElseIf lngItemTypeID = SUR_ITEM_MATRIX_SINGLE_SELECT_OPTIONS Or lngItemTypeID = SUR_ITEM_MATRIX_MULTISELECT_CHECKBOXES Then
'Build a string of name/value pairs by looping through the question recordset (which also has pre-defined answers).
'This string is logically a collection of name/value pairs separated by semi-colons (;) in the format
'SIDxxxAIDyyy;6;SIDxxxAIDyyy;7;SIDxxxAIDyyy;1, where xxx represents the subitem ID and yyy represents the
'answer ID. This section sets the collection to values of 0 for all possible answers. Also create a
'collection of subitem ID's to subitem text for displaying the results.
Do While lngItemID = rsQuestions("item_id")
'The outer loop goes through the answer ID's (the columns), while the inner loop goes through the subitems
'(the rows).
rsSubItems.MoveFirst
Do While Not rsSubItems.EOF
'When adding each possible answer to the collection, initialize to 0
strAnswersCollection = strAnswersCollection & "SID" & rsSubItems("subitem_id") & "AID" & rsQuestions("answer_id") & ";0;"
rsSubItems.MoveNext
Loop
'Add all of the ID/Value pairs to another collection for display purposes later
strAnswerIDsCollection = strAnswerIDsCollection & rsQuestions("answer_id") & ";" & rsQuestions("ItemAnswerText") &";"
'Record the total number of answers, which is needed to correctly render matrix questions below
lngAnswerCount = lngAnswerCount + 1
rsQuestions.MoveNext
If rsQuestions.EOF = True Then
Exit Do
End If
Loop
'Initialize the collection for tracking the number of responses per subitem
rsSubItems.MoveFirst
Do While Not rsSubItems.EOF
'When adding each possible answer to the collection, initialize to 0
strUniqueRespondentsPerAnswerCollection = strUniqueRespondentsPerAnswerCollection & rsSubItems("subitem_id") & ";0;"
rsSubItems.MoveNext
Loop
'Add one more name/value pair to the collection for null answers.
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_NULL & ";0;"
'Call a function that strips off all extra semi-colons
strAnswersCollection = CleanAnswersCollection(strAnswersCollection)
strAnswerIDsCollection = CleanAnswersCollection(strAnswerIDsCollection)
strUniqueRespondentsPerAnswerCollection = CleanAnswersCollection(strUniqueRespondentsPerAnswerCollection)
'Loop through the actual answers and increment the counts for each. The counts are incremented in
'the helper function, IncrementCountInCollection
If Not rsAnswers.EOF Then
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
If lngCurrentResponseID <> rsAnswers("response_id") Then
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
End If
'Increment the appropriate subitem in the collection. If the subitem_id is Null, record a non-response
If CStr(rsAnswers("ResponseAnswerID")) = CStr(SUR_ANSWER_ID_NULL) Then
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, SUR_ANSWER_TEXT_NULL)
Else 'An ID response was recorded
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, "SID" & CStr(rsAnswers("subitem_id")) & "AID" & CStr(rsAnswers("ResponseAnswerID")))
'Track the number of unique respondents per row by adding one to the count for each response.
If lngItemTypeID = SUR_ITEM_MATRIX_SINGLE_SELECT_OPTIONS Or lngItemTypeID = SUR_ITEM_MATRIX_RATING_SCALE Then
strUniqueRespondentsPerAnswerCollection = IncrementCountInCollection(strUniqueRespondentsPerAnswerCollection, CStr(rsAnswers("subitem_id")))
Else 'SUR_ITEM_MATRIX_MULTISELECT_CHECKBOXES
If lngCurrentResponseID <> rsAnswers("response_id") Or lngCurrentSubItemID <> rsAnswers("subitem_id") Then
strUniqueRespondentsPerAnswerCollection = IncrementCountInCollection(strUniqueRespondentsPerAnswerCollection, CStr(rsAnswers("subitem_id")))
End If
lngCurrentResponseID = rsAnswers("response_id")
lngCurrentSubItemID = rsAnswers("subitem_id")
End If
End If
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
End If
ElseIf lngItemTypeID = SUR_ITEM_MATRIX_RATING_SCALE Then
'Get the beginning and ending numbers for the rating scale
lngBeginningNumber = rsQuestions("minimum_value")
lngEndingNumber = rsQuestions("maximum_value")
'If rsQuestions("other_yn") = SUR_BOOLEAN_POSITIVE Then
' lngEndingNumber = lngEndingNumber + 1
'End If
'Record the total number of answers, which is needed to correctly render matrix questions below
lngAnswerCount = lngEndingNumber - lngBeginningNumber + 1
'Build a string of name/value pairs by looping from the beginning to the ending value of the rating scale.
'This string is logically a collection of name/value pairs separated by semi-colons (;) in the format
'SIDxxxAIDyyy;6;SIDxxxAIDyyy;7;SIDxxxAIDyyy;1, where xxx represents the subitem ID and yyy represents the
'the numeric value of the number in the rating scale. This section sets the collection to values of 0 for
'all possible answers. Also create a collection of subitem ID's to subitem text for displaying the results.
Do While CLng(lngBeginningNumber) <= CLng(lngEndingNumber)
'The outer loop goes through the answer ID's (the columns), while the inner loop goes through the subitems
'(the rows).
rsSubItems.MoveFirst
Do While Not rsSubItems.EOF
'When adding each possible answer to the collection, initialize to 0
strAnswersCollection = strAnswersCollection & "SID" & rsSubItems("subitem_id") & "AID" & lngBeginningNumber & ";0;"
rsSubItems.MoveNext
Loop
'Add all of the ID/Value pairs to another collection for display purposes later
strAnswerIDsCollection = strAnswerIDsCollection & CStr(lngBeginningNumber) & ";" & CStr(lngBeginningNumber) & ";"
'Incremenet the current number in the rating scale
lngBeginningNumber = lngBeginningNumber + 1
Loop
If rsQuestions("other_yn") = SUR_BOOLEAN_POSITIVE Then
strAnswersCollection = strAnswersCollection & "SID6AID6;0;"
strAnswerIDsCollection = strAnswerIDsCollection & "6;6;"
End IF
'Initialize the collection for tracking the number of responses per subitem
rsSubItems.MoveFirst
Do While Not rsSubItems.EOF
'When adding each possible answer to the collection, initialize to 0
strUniqueRespondentsPerAnswerCollection = strUniqueRespondentsPerAnswerCollection & rsSubItems("subitem_id") & ";0;"
rsSubItems.MoveNext
Loop
If rsQuestions("other_yn") = SUR_BOOLEAN_POSITIVE Then
strUniqueRespondentsPerAnswerCollection = strUniqueRespondentsPerAnswerCollection & "6;0;"
End IF
'Add one more name/value pair to the collection for null answers.
strAnswersCollection = strAnswersCollection & SUR_ANSWER_TEXT_NULL & ";0;"
'Call a function that strips off all extra semi-colons
strAnswersCollection = CleanAnswersCollection(strAnswersCollection)
strAnswerIDsCollection = CleanAnswersCollection(strAnswerIDsCollection)
strUniqueRespondentsPerAnswerCollection = CleanAnswersCollection(strUniqueRespondentsPerAnswerCollection)
'Loop through the actual answers and increment the counts for each. The counts are incremented in
'the helper function, IncrementCountInCollection
If Not rsAnswers.EOF Then
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
If lngCurrentResponseID <> rsAnswers("response_id") Then
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
lngCurrentResponseID = rsAnswers("response_id")
End If
'Increment the appropriate subitem in the collection. If the subitem_id is Null, record a non-response
If CStr(rsAnswers("ResponseAnswerID")) = CStr(SUR_ANSWER_ID_NULL) Then
If rsQuestions("other_yn") = SUR_BOOLEAN_POSITIVE Then
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, "SID6AID6")
strUniqueRespondentsPerAnswerCollection = IncrementCountInCollection(strUniqueRespondentsPerAnswerCollection, "6")
Else
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, SUR_ANSWER_TEXT_NULL)
End If
Else 'An ID response was recorded
strAnswersCollection = IncrementCountInCollection(strAnswersCollection, "SID" & CStr(rsAnswers("subitem_id")) & "AID" & CStr(rsAnswers("ResponseAnswerID")))
'Track the number of unique respondents per row by adding one to the count for each response.
strUniqueRespondentsPerAnswerCollection = IncrementCountInCollection(strUniqueRespondentsPerAnswerCollection, CStr(rsAnswers("subitem_id")))
End If
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
End If
'Move to the next question
rsQuestions.MoveNext
ElseIf lngItemTypeID = SUR_ITEM_OPEN_ENDED_ONE_LINE Or lngItemTypeID = SUR_ITEM_OPEN_ENDED_ONE_LINE_NON_QUESTION Or lngItemTypeID = SUR_ITEM_OPEN_ENDED_COMMENTS_BOX Or lngItemTypeID = SUR_ITEM_DATE Or lngItemTypeID = SUR_ITEM_NUMBER Or lngItemTypeID = SUR_ITEM_DATABASE_DROPDOWN Then 'Text
'Get the number of responses and non-responses
lngSkippedTotal = 0
lngTextResponseCount = 0
lngNumberTotal = 0
'If there are no more answers, the next question was not answered.
If Not rsAnswers.EOF Then
'Loop through the actual answers and count them.
Do While lngItemID = rsAnswers("item_id")
'Track the number of responses
lngResponseCount = lngResponseCount + 1
'Track the number of unique respondents
lngUniqueRespondentCount = lngUniqueRespondentCount + 1
'Calculate the number of skipped responses
If rsAnswers("ResponseAnswerText") = SUR_ANSWER_TEXT_NULL Then
lngSkippedTotal = lngSkippedTotal + 1
Else
lngTextResponseCount = lngTextResponseCount + 1
'For number questions, track the total
If lngItemTypeID = SUR_ITEM_NUMBER Then
lngNumberTotal = lngNumberTotal + CLng(rsAnswers("ResponseAnswerText"))
End If
End If
rsAnswers.MoveNext
If rsAnswers.EOF = True Then
Exit Do
End If
Loop
Else
'There are no answers at all to this item, so set the response counts equal to the total number of
'respondents in order to trigger a display of "No results" below.
lngSkippedTotal = lngFilteredRespondents
lngResponseCount = lngFilteredRespondents
End If
'Advance to the next question
rsQuestions.MoveNext
Else
'Should never get here. All non-question items (image, heading, HTML, etc.) were filtered out in
'the query above.
End If
If (strItemText <> "Your Name:" And strItemText <> "Department:" And strItemText <> "Name of person you are completing this survey on:" And strItemText <> "Please provide comments here:") Then
'This section displays the results for matrix rating scale questions
'Get the total number of skipped items
lngSkippedTotal = CLng(GetValueFromCollection(strAnswersCollection, SUR_ANSWER_TEXT_NULL))
'Create an array of all the name value pairs for the answers
vaAnswers = Split(strAnswerIDsCollection, ";")
'Loop through the subitems collection, outputting the responses for each
rsSubItems.MoveFirst
Do While Not rsSubItems.EOF
lngRowTotal = 0
lngRowAverage = 0
For i = 0 To UBound(vaAnswers) Step 2
'Calculate the response total and the response average for this row
If GetValueFromCollection(strAnswerIDsCollection, vaAnswers(i)) = 6 then
lngRowTotal = lngRowTotal + CLng(GetValueFromCollection(strAnswersCollection, "SID6AID6"))
lngRowAverage = lngRowAverage + (CLng(CLng(GetValueFromCollection(strAnswersCollection, "SID6AID6"))) * CLng(GetValueFromCollection(strAnswerIDsCollection, vaAnswers(i))))
Else
lngRowTotal = lngRowTotal + CLng(GetValueFromCollection(strAnswersCollection, "SID" & rsSubItems("subitem_id") & "AID" & vaAnswers(i)))
lngRowAverage = lngRowAverage + (CLng(CLng(GetValueFromCollection(strAnswersCollection, "SID" & rsSubItems("subitem_id") & "AID" & vaAnswers(i)))) * CLng(GetValueFromCollection(strAnswerIDsCollection, vaAnswers(i))))
End If
Next
strBody = strBody & "<tr>"
strBody = strBody & "<td>" & lngQuestionNumber & ".</td>"
strBody = strBody & "<td>" & strItemText & "</td>"
'Loop through the answers array. Do a Step 2 because every other item in the array
'is the value for the item.
For i = 0 To UBound(vaAnswers) Step 2
If GetValueFromCollection(strAnswerIDsCollection, vaAnswers(i)) = 6 then
lngColspanCount = 4 + lngAnswerCount
End If
strBody = strBody & "<td align='center' valign='center' class='WhiteBackgroundColor'><span class='Normal'>"
If GetValueFromCollection(strAnswerIDsCollection, vaAnswers(i)) = 6 then
strBody = strBody & GetValueFromCollection(strAnswersCollection, "SID6AID6")
Else
If GetValueFromCollection(strUniqueRespondentsPerAnswerCollection, rsSubItems("subitem_id")) = "0" Then
'Response.Write "0% (0)"
strBody = strBody & "0"
Else
strBody = strBody & GetValueFromCollection(strAnswersCollection, "SID" & rsSubItems("subitem_id") & "AID" & vaAnswers(i))
End If
End IF
strBody = strBody & "</span>"
strBody = strBody & "</td>"
Next
strBody = strBody & "<td align='center' valign='center' class='WhiteBackgroundColor'><span class='NormalBold'>"
If lngRowTotal = 0 Then
'Response.Write "0"
strBody = strBody & "0"
Else
'Response.Write FormatNumber(lngRowAverage/lngRowTotal, 1)
strBody = strBody & FormatNumber(lngRowAverage/lngRowTotal, 1)
End If
strBody = strBody & "</span>"
strBody = strBody & "</td>"
strBody = strBody & "<td align='center' valign='center' class='WhiteBackgroundColor'>"
strBody = strBody & "<span class='NormalBold'>"
strBody = strBody & lngRowTotal
strBody = strBody & "</span>"
strBody = strBody & "</td>"
strBody = strBody & "</tr>"
rsSubItems.MoveNext
Loop
End If
'If the subitems recordset is open, close it for the next iteration
If lngItemTypeID = SUR_ITEM_CONSTANT_SUM Or lngItemTypeID = SUR_ITEM_RANKING Or lngItemTypeID = SUR_ITEM_MATRIX_SINGLE_SELECT_OPTIONS Or lngItemTypeID = SUR_ITEM_MATRIX_RATING_SCALE Or lngItemTypeID = SUR_ITEM_MATRIX_MULTISELECT_CHECKBOXES Or lngItemTypeID = SUR_ITEM_MATRIX_TEXT_BOXES Or lngItemTypeID = SUR_ITEM_OPEN_ENDED_ONE_OR_MORE_LINES Then
rsSubItems.Close
End If
' DMB - 092906
If lngItemTypeID <> SUR_ITEM_OPEN_ENDED_ONE_LINE_NON_QUESTION and lngItemTypeID <> SUR_ITEM_SINGLE_SELECT_DROPDOWN_NON_QUESTION Then
'Increment the item number
lngQuestionNumber = lngQuestionNumber + 1
End If
Loop
strBody = strBody & "</table>"
strBody = strBody & "</body>"
strBody = strBody & "</html>"
Set rsEmailAddress = Server.CreateObject("ADODB.Recordset")
Dim strEmailAddress
strSQL = "SELECT email_address FROM sur_user WHERE user_id=" & lngUserID & ";"
rsEmailAddress.Open ConvertSQL(strSQL), SURVEY_APP_CONNECTION, adOpenDynamic, , adCmdText
strEmailAddress = rsEmailAddress("email_address")
rsEmailAddress.Close
Set cdoMessage = CreateObject("CDO.Message")
cdoMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
cdoMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")="localhost"
cdoMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
cdoMessage.From = "info@focus3.biz"
cdoMessage.To = strEmailAddress
cdoMessage.Subject = "Focus3 Survey Results"
cdoMessage.HTMLBody = strBody
cdoMessage.Send
Set cdoMessage = Nothing
Response.Redirect("ResultsSent.asp?SurveyID=" & Request.QueryString("SurveyID") & "&UserID=" & Request.QueryString("UserID") & "&EmailAddress=" & strEmailAddress)
%>
You may consider to add in a check to check whether the rsSubItems is an Object of the connection before the condition kicks in.
If (isObject(rsSubItems) and strItemText <> "Your Name:" And strItemText <> "Department:" And strItemText <> "Name of person you are
completing this survey on:" And strItemText <> "Please provide comments here:") Then
If (isObject(rsSubItems) and strItemText <> "Your Name:" And strItemText <> "Department:" And strItemText <> "Name of person you are
completing this survey on:" And strItemText <> "Please provide comments here:") Then
On line 311 you have the below condition to open rsSubItems
'If the current question has subitems, query to obtain the list of subitems
Perhaps this particular survey doesn't meet that condition, so it isn't open when it's needed on line 828
'If the current question has subitems, query to obtain the list of subitems
Perhaps this particular survey doesn't meet that condition, so it isn't open when it's needed on line 828
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
This appears to be the only place in the page where you actually open the object rsSubItems.
Line 828 expects an open object in order to work.
If this has worked in the past but not now, then you have some new data now that didn't exist when the query used to work.
You might seriously consider dropping the IF statement from the opening of that query and try to open the query anyways unless that will cause a crash for some reason.