Robert G. Erhart Bob Erhart Rochester New York

HOME

ADD MESSAGE

PAGE/EMAIL

TAKE A DEMO SURVEY

SEE DEMO SURVEY RESULTS

VBA DEMO

BACK TO SOURCE CODE LISTING

'================================================================================
'
'
'================================================================================
Private Function GetQuestions(strName, strSubjectName, strSubject, strQuestionSubjectName, strQuestionSubject)
'----------------------------------------------------------------------
'
'----------------------------------------------------------------------
        Dim objConn
        Dim objSurveyRS 
        Dim strSql            
        Dim varRC, intFieldCount, intFC
        Dim strFieldNameBuf, varFieldValueBuf
        Dim strSurveyName, strQuestionName, strQuestion
        Dim strTargetField, booSubmitButton
        Dim strHTMLFieldType, intCols, intRows, strGroupName, strDefault
            strSql = "SELECT * FROM Questions WHERE SurveyName=" & SingleQuote(strName) & " AND SubjectName=" & SingleQuote(strSubjectName) & " AND QuestionSubjectName=" & SingleQuote(strQuestionSubjectName) & "ORDER BY Sequence;"

Set objConn = Server.CreateObject("ADODB.Connection")
            objConn.Open adoConnectString_Data_Read
        Set objSurveyRS = objConn.Execute(strSql)
          intFieldCount = objSurveyRS.Fields.Count
          Do while Not objSurveyRS.EOF
             For intFC = 0 to (intFieldCount - 1)
              strFieldNameBuf = UCase(objSurveyRS(intFC).Name)
              varFieldValueBuf = objSurveyRS(intFC).Value
             
              Select Case strFieldNameBuf
               Case UCase("SurveyName")
                strSurveyName = varFieldValueBuf
               Case UCase("SubjectName")
                strSubjectName = varFieldValueBuf
               Case UCase("QuestionSubjectName")
                strQuestionSubjectName = varFieldValueBuf
               Case UCase("QuestionName")
                strQuestionName = varFieldValueBuf
               Case UCase("Question")
                strQuestion = varFieldValueBuf
               Case UCase("HTMLFieldType")
                strHTMLFieldType = UCase(varFieldValueBuf)
               Case UCase("Cols")
                intCols = varFieldValueBuf
               Case UCase("Rows")
                intRows = varFieldValueBuf
               Case UCase("GroupName")
                strGroupName = varFieldValueBuf
               Case UCase("Default")
                strDefault = varFieldValueBuf
               Case UCase("SubmitButton")
                booSubmitButton = varFieldValueBuf
               Case Else
                'Do Nothing        
              End Select
             Next

strTargetField = strSubjectName & "_" & strQuestionSubjectName & "_" & strQuestionName 
             strTargetField = FixLabel(strTargetField)

Select Case strHTMLFieldType
              Case "TEXT"
               varRC = HTMLFieldText(strName, strTargetField, strQuestion, intCols, strDefault)
              Case "RADIO"
               varRC = HTMLFieldRadio(strName, strTargetField, strQuestion, intRows, strDefault, strGroupName)
              Case "TEXTAREA"
               varRC = HTMLFieldTextArea(strName, strTargetField, strQuestion, intCols, intRows, strDefault)
              Case "SELECT"
               varRc = HTMLFieldSelect(strName, strTargetField, strQuestion, intRows, strDefault, strGroupName)
              Case "CHECKBOX"
               varRC = HTMLFieldCheckBox(strName, strTargetField, strQuestion, strDefault)
              Case Else
               varRC = HTMLFieldText(strName, strTargetField, strQuestion, intCols, strDefault)
             End Select

objSurveyRS.MoveNext
            Loop
            objSurveyRS.Close
        Set objSurveyRS = Nothing
            objConn.Close
        Set objConn = Nothing

If booSubmitButton = True Then
%>
 <TR>
  <TD COLSPAN=2 CLASS="FORM" valign=middle align=center bgcolor=#ffffcc><INPUT CLASS="BUTTON" TYPE="SUBMIT" value="Submit your <% = strSurveyName %> survey results" name=SUBMIT></TD>
 </TR>
<%
End If 
End Function