usingvb3: Never

usingvb4: Never

usingvb5: Never

usingvb6: Constantly

usingvbnet: Never

futurevb3: DontNeedIt

futurevb4: DontNeedIt

futurevb5: DontNeedIt

futurevb6: AtLeast5Years

movetonet: Never

The AnswerCount class stores information about one answer for a question. It simply contains two public variables: AnswerText and Count.

The Question class stores data for a question. It has a string named QuestionText that stores the question's text. It also has a collection of AnswerCount objects named Answers.

The Question class's Initialize method takes as a parameter an array of strings giving the possible answers for the question and it makes AnswerCount objects for each of them.

Public QuestionText As String
Public Answers As Collection

Public Sub Initialize(ByVal question_text As String, ByVal _
    answer_values As Variant)
Dim i As Integer
Dim new_answer_count As AnswerCount

    QuestionText = question_text

    Set Answers = New Collection
    For i = LBound(answer_values) To UBound(answer_values)
        Set new_answer_count = New AnswerCount
        new_answer_count.AnswerText = answer_values(i)
        new_answer_count.Count = 0
        Answers.Add new_answer_count, _
            new_answer_count.AnswerText
    Next i
End Sub

After creating all of the Questions, cmdLoad_Click loops through the files in the survey directory, calling subroutine ProcessFile for each file.

It then loops through the question data displaying the results in the Debug window and generating HTML output to display the results in a nicely formatted table.

Private Sub cmdLoad_Click()
Dim questions As Collection
Dim file_path As String
Dim file_name As String
Dim ques As Question
Dim ans As AnswerCount
Dim total As Integer
Dim txt As String
Dim percent As Integer
Dim num_files As Integer

    ' Load the questions.
    Set questions = New Collection
    MakeQuestion questions, "usingvb3", Array("Never", _
        "Seldom", "Often", "Constantly")
    MakeQuestion questions, "usingvb4", Array("Never", _
        "Seldom", "Often", "Constantly")
    MakeQuestion questions, "usingvb5", Array("Never", _
        "Seldom", "Often", "Constantly")
    MakeQuestion questions, "usingvb6", Array("Never", _
        "Seldom", "Often", "Constantly")
    MakeQuestion questions, "usingvbnet", Array("Never", _
        "Seldom", "Often", "Constantly", "Soon")

    MakeQuestion questions, "futurevb3", _
        Array("DontNeedIt", "AtLeast6Months", _
        "AtLeast1Year", "AtLeast5Years", "Forever")
    MakeQuestion questions, "futurevb4", _
        Array("DontNeedIt", "AtLeast6Months", _
        "AtLeast1Year", "AtLeast5Years", "Forever")
    MakeQuestion questions, "futurevb5", _
        Array("DontNeedIt", "AtLeast6Months", _
        "AtLeast1Year", "AtLeast5Years", "Forever")
    MakeQuestion questions, "futurevb6", _
        Array("DontNeedIt", "AtLeast6Months", _
        "AtLeast1Year", "AtLeast5Years", "Forever")

    MakeQuestion questions, "movetonet", Array("Never", _
        "NotThisYear", "InNextYear", "InNext6Months", "Now")

    ' Process the files.
    file_path = txtDirectory.Text & "\"
    file_name = Dir$(file_path & "*", vbNormal)
    Do While Len(file_name) > 0
        num_files = num_files + 1
        ProcessFile questions, file_path & file_name
        file_name = Dir$(, vbNormal)
    Loop

    ' Generate Debug output.
    Debug.Print "===== Results ====="
    For Each ques In questions
        Debug.Print ques.QuestionText

        For Each ans In ques.Answers
            Debug.Print "    " & ans.AnswerText & ": " & _
                ans.Count
        Next ans
    Next ques

    ' Generate HTML output.
    txt = "<P>" & vbCrLf
    txt = txt & "<TABLE BORDER=""1"" WIDTH=""100%"">" & _
        vbCrLf
    txt = txt & "  <TR><TD COLSPAN=""6"" " & _
        "ALIGN=""Center""><B><FONT SIZE=""+2"" " & _
        "COLOR=""#0000FF"">Results</FONT></B>"
    txt = txt & "<BR>(Percentages of " & Format$(num_files) _
        & " responses)</TD></TR>" & vbCrLf
    For Each ques In questions
        txt = txt & "  <TR>" & vbCrLf
        txt = txt & "    <TH>" & ques.QuestionText & _
            "</TH>" & vbCrLf

        total = 0
        For Each ans In ques.Answers
            total = total + ans.Count
        Next ans

        For Each ans In ques.Answers
            percent = CInt(ans.Count / total * 100)
            txt = txt & "    <TD>" & ans.AnswerText & "<BR>"
            txt = txt & "<IMG SRC=""magenta_mid.jpg"" " & _
                "WIDTH="""
            txt = txt & Format$(percent)
            txt = txt & """ HEIGHT=""10"">" & percent & _
                "</TD>" & vbCrLf
            ' txt = txt & """ HEIGHT=""10"">" & percent &
            ' "/" & ans.Count & "</TD>" & vbCrLf
        Next ans
        txt = txt & "  </TR>" & vbCrLf
    Next ques
    txt = txt & "</TABLE>" & vbCrLf
    rchResult.Text = txt
    rchResult.SetFocus
    rchResult.SelStart = 0
    rchResult.SelLength = Len(txt)
End Sub

Private Sub MakeQuestion(ByVal questions As Collection, _
    ByVal question_text As String, ByVal answer_values As _
    Variant)
Dim new_question As Question

    Set new_question = New Question
    new_question.Initialize question_text, answer_values
    questions.Add new_question, question_text
End Sub

Private Sub ProcessFile(ByVal questions As Collection, _
    ByVal file_name As String)
Dim fnum As Integer
Dim file_contents As String
Dim the_question As Question
Dim the_answer As AnswerCount
Dim answer_txt As String
Dim pos1 As Integer
Dim pos2 As Integer

    Debug.Print "> " & file_name

    ' Grab the file.
    fnum = FreeFile
    Open file_name For Input As #fnum
    file_contents = Input$(LOF(fnum), fnum)
    Close fnum

    ' Look for the questions.
    For Each the_question In questions
        pos1 = InStr(file_contents, vbCrLf & _
            the_question.QuestionText)
        If pos1 < 1 Then
            Debug.Print "*** Could not find question " & _
                the_question.QuestionText
        Else
            pos1 = InStr(pos1, file_contents, ":") + 1
            pos2 = InStr(pos1, file_contents, vbCrLf)
            answer_txt = Trim$(Mid$(file_contents, pos1, _
                pos2 - pos1))

            Set the_answer = _
                the_question.Answers(answer_txt)
            the_answer.Count = the_answer.Count + 1
        End If
    Next the_question
End Sub