Hi everyone,
I am a new member here and totally new to VBS. My company asked me to send out an in house survey to rate our performance and gather feedback.
I downloaded and published a sample survey in our organizational library. Everything works but now I need to make adjustments for our survey.
So the few things I'm trying to figure out are, how do I make multiple inputs for a single question? For example when I answer a question in this form, I am able to choose the type of question being asked and will provide a way to answer (text, choice, scale, y/n). What if I have a question like, "What is your favorite color?" and the choices are red, blue, green, other. When the users chooses "other" a text box prompts them to enter their favorite color. (yes, I know, horrible example)
My second question is how do I set up my scale to prompt a text box if they enter a certain choice. For example, if I asked users to rate our department on a scale of 1-10, and if the users chooses anything below 5 then we prompt them to enter a comment.
Once again, I have very limited VBS knowledge. I tend to play around with the code a lot and see if it works. If you look at my code carefully you can see that I changed the AgreeScale to a 1-10 scale.(shows how bad I am)
Hopefully I was clear on my questions. Thanks in advance!
I am a new member here and totally new to VBS. My company asked me to send out an in house survey to rate our performance and gather feedback.
I downloaded and published a sample survey in our organizational library. Everything works but now I need to make adjustments for our survey.
Dim lstQuestions, txtQuestionText, cboQuestionType
Dim txtAnswer, txtAnswer2, lblRate, txtRate, lblqstatus, chkcsv
Dim cmdStart, cmdNext, cmdBack, cmdFinish
Dim aryQuestions
Dim intCurrentQuestion, aryAnswers()
Dim strCurrentQuestionType
Dim fraYesNo, optYes, optNo, optNA
Dim fraAgree, optStrDisagree, optDisagree, optNeutral, optAgree, optStrAgree, OptionButton11, OptionButton12, OptionButton13, OptionButton14, OptionButton15
Dim fraChoice, optchoice1, optchoice2, optchoice3, optchoice4, optchoice5
Dim txtChoices, lblchoices
Dim StrParsedChoices
Function Item_Open()
Dim objControls
Set objControls = Item.GetInspector.ModifiedFormPages("Message").Controls
If Item.EntryID = "" Then
Set lstQuestions = objControls("lstQuestions")
Set txtQuestionText = objControls("txtQuestionText")
Set cboQuestionType = objControls("cboQuestionType")
Set txtChoices = objControls("txtChoices")
Set lblchoices = objControls("lblChoices")
Else
Set lblqstatus = objControls("lblqinfo")
Set txtQuestionText = objControls("tbquestion")
Set txtAnswer = objControls("txtAnswer")
Set fraYesNo = objControls("fraYesNo")
Set fraAgree = objControls("fraAgree")
Set fraChoice = objControls("fraChoice")
Set lblRate = objControls("lblRate")
Set txtRate = objControls("txtRate")
Set cmdNext = objControls("cmdNext")
Set cmdBack = objControls("cmdBack")
Set cmdFinish = objControls("cmdFinish")
Set optYes = fraYesNo.Controls("optYes")
Set optNo = fraYesNo.Controls("optNo")
Set optNA = fraYesNo.Controls("optNA")
Set optStrDisagree = fraAgree.Controls("optStrDisagree")
Set optDisagree = fraAgree.Controls("optDisagree")
Set optNeutral = fraAgree.Controls("optNeutral")
Set optAgree = fraAgree.Controls("optAgree")
Set optStrAgree = fraAgree.Controls("optStrAgree")
Set OptionButton11 = fraAgree.Controls("OptionButton11")
Set OptionButton12 = fraAgree.Controls("OptionButton12")
Set OptionButton13 = fraAgree.Controls("OptionButton13")
Set OptionButton14 = fraAgree.Controls("OptionButton14")
Set OptionButton15 = fraAgree.Controls("OptionButton15")
Set optchoice1 = fraChoice.Controls("optChoice1")
Set optchoice2 = fraChoice.Controls("optChoice2")
Set optchoice3 = fraChoice.Controls("optChoice3")
Set optchoice4 = fraChoice.Controls("optChoice4")
Set optchoice5 = fraChoice.Controls("optChoice5")
Set txtAnswer2 = fraChoice.Controls("txtAnswer2")
ReDim aryAnswers(Item.Mileage)
Call InitializeRead
End If
End Function
Sub cmdAdd_Click()
Dim strQuestionText, strQuestionType, strQuestionChoices, strQuestionComposite
strQuestionText = Item.UserProperties.Find("oneq").Value
strQuestionType = Item.UserProperties.Find("onetype").Value
If strQuestionText = "" Or (strQuestionType = "Choice" And txtChoices = "") Then
MsgBox "Please fill in a value for the Question And/Or Answer Choices"
Exit Sub
End If
If strQuestionType = "Choice" And InStr(txtChoices, ";") = 0 Then
MsgBox "Your must have at least two choices, separated by a semi-colon."
Exit Sub
End If
If strQuestionType = "" Then strQuestionType = "Text"
strQuestionComposite = strQuestionType & ": " & strQuestionText
If strQuestionType = "Choice" Then
strQuestionComposite = strQuestionComposite & " {" & txtChoices & "}"
End If
lstQuestions.AddItem strQuestionComposite
txtQuestionText.Text = ""
cboQuestionType.SetFocus
End Sub
Sub cmdClear_Click()
lstQuestions.Clear
txtQuestionText.SetFocus
End Sub
Sub cmdUp_Click()
Dim strQuestionTemp
olistindex = lstQuestions.ListIndex
If olistindex = -1 Then
MsgBox "No entry is selected."
Exit Sub
End If
If olistindex = 0 Then
Exit Sub
End If
strQuestionTemp = lstQuestions.List(olistindex)
lstQuestions.List(olistindex) = lstQuestions.List(olistindex - 1)
lstQuestions.List(olistindex - 1) = strQuestionTemp
txtQuestionText.SetFocus
End Sub
Sub cmdDown_Click()
Dim strQuestionTemp
olistindex = lstQuestions.ListIndex
If olistindex = -1 Then
MsgBox "No entry is selected."
Exit Sub
End If
If olistindex = lstQuestions.ListCount - 1 Then
Exit Sub
End If
strQuestionTemp = lstQuestions.List(olistindex)
lstQuestions.List(olistindex) = lstQuestions.List(olistindex + 1)
lstQuestions.List(olistindex + 1) = strQuestionTemp
lstQuestions.ListIndex = olistindex + 1
txtQuestionText.SetFocus
End Sub
Sub cmdRemove_Click()
lstQuestions.RemoveItem lstQuestions.ListIndex
txtQuestionText.SetFocus
End Sub
Sub Item_Send()
For l = 0 To lstQuestions.ListCount - 1
alldata = alldata & lstQuestions.List(l) & "|"
Next
alldata = Left(alldata, Len(alldata) - 1)
Item.Body = alldata
Item.Mileage = lstQuestions.ListCount
End Sub
Sub AllowInput(strType)
Select Case strType
Case "Text"
txtAnswer.Visible = True
Case "Y/N"
fraYesNo.Visible = True
Case "Agree Scale"
fraAgree.Visible = True
Case "1-10"
txtRate.Visible = True
lblRate.Visible = True
Case "Choice"
arysplitchoices = Split(StrParsedChoices, ";")
ReDim Preserve arysplitchoices(5)
For I = 0 To 4
If arysplitchoices(I) = "" Then
arysplitchoices(I) = "Unused"
End If
Next
optchoice1.Caption = arysplitchoices(0)
optchoice2.Caption = arysplitchoices(1)
optchoice3.Caption = arysplitchoices(2)
optchoice4.Caption = arysplitchoices(3)
optchoice5.Caption = arysplitchoices(4)
fraChoice.Visible = True
End Select
End Sub
Sub RestrictInput()
txtAnswer.Text = ""
txtAnswer.Visible = False
optYes.Value = 1
fraYesNo.Visible = False
fraAgree.Visible = False
optStrAgree.Value = 1
txtRate.Text = ""
txtRate.Visible = False
lblRate.Visible = False
optchoice1.Value = 1
fraChoice.Visible = False
Item.Display
End Sub
Sub ShowQuestion(intNumber)
typemarker = InStr(aryQuestions(intNumber), ":")
strCurrentQuestionType = Left(aryQuestions(intNumber), typemarker - 1)
howmuch = Len(aryQuestions(intNumber)): howmuch = howmuch - typemarker
questiononly = Right(aryQuestions(intNumber), howmuch)
If strCurrentQuestionType = "Choice" Then
istartchoices = InStr(questiononly, "{")
howmuchquestion = Len(questiononly): howmuchquestion = howmuch - istartchoices
StrParsedChoices = Right(questiononly, howmuchquestion)
StrParsedChoices = Left(StrParsedChoices, Len(StrParsedChoices) - 1)
End If
txtQuestionText.Text = questiononly
AllowInput (strCurrentQuestionType)
If intNumber = (Item.Mileage - 1) Then cmdFinish.Enabled = True Else cmdFinish.Enabled = False
If intNumber < (Item.Mileage - 1) Then cmdNext.Enabled = True Else cmdNext.Enabled = False
If intNumber > 0 Then cmdBack.Enabled = True Else cmdBack.Enabled = False
End Sub
Sub updateqinfo()
lblqstatus.Caption = "(" & CStr(intCurrentQuestion + 1) & " of " & CStr(Item.Mileage) & ")"
End Sub
Sub InitializeRead()
alldata = CStr(Item.Body)
aryQuestions = Split(alldata, "|")
intCurrentQuestion = 0
ShowQuestion (intCurrentQuestion)
Call updateqinfo
End Sub
Sub RecordAnswer()
Select Case strCurrentQuestionType
Case "Text"
aryAnswers(intCurrentQuestion) = txtAnswer.Text
Case "Y/N"
If optYes.Value Then
aryAnswers(intCurrentQuestion) = optYes.Caption
ElseIf optNo.Value Then
aryAnswers(intCurrentQuestion) = optNo.Caption
ElseIf optNA.Value Then
aryAnswers(intCurrentQuestion) = optNA.Caption
End If
Case "Agree Scale"
If optStrDisagree.Value Then
aryAnswers(intCurrentQuestion) = optStrDisagree.Caption
ElseIf optDisagree.Value Then
aryAnswers(intCurrentQuestion) = optDisagree.Caption
ElseIf optNeutral.Value Then
aryAnswers(intCurrentQuestion) = optNeutral.Caption
ElseIf optAgree.Value Then
aryAnswers(intCurrentQuestion) = optAgree.Caption
ElseIf optStrAgree.Value Then
aryAnswers(intCurrentQuestion) = optStrAgree.Caption
ElseIf OptionButton11.Value Then
aryAnswers(intCurrentQuestion) = OptionButton11.Caption
ElseIf OptionButton12.Value Then
aryAnswers(intCurrentQuestion) = OptionButton12.Caption
ElseIf OptionButton13.Value Then
aryAnswers(intCurrentQuestion) = OptionButton13.Caption
ElseIf OptionButton14.Value Then
aryAnswers(intCurrentQuestion) = OptionButton14.Caption
ElseIf OptionButton15.Value Then
aryAnswers(intCurrentQuestion) = OptionButton15.Caption
End If
Case "Choice"
If optchoice1.Value Then
aryAnswers(intCurrentQuestion) = optchoice1.Caption
ElseIf optchoice2.Value Then
aryAnswers(intCurrentQuestion) = optchoice2.Caption
ElseIf optchoice3.Value Then
aryAnswers(intCurrentQuestion) = optchoice3.Caption
ElseIf optchoice4.Value Then
aryAnswers(intCurrentQuestion) = optchoice4.Caption
ElseIf optchoice5.Value Then
aryAnswers(intCurrentQuestion) = optchoice5.Caption
End If
Case "1-10"
aryAnswers(intCurrentQuestion) = txtRate.Text
End Select
End Sub
Sub cmdBack_Click()
Call RecordAnswer
Call RestrictInput
If intCurrentQuestion = 0 Then Exit Sub
intCurrentQuestion = intCurrentQuestion - 1
ShowQuestion (intCurrentQuestion)
Call updateqinfo
Call LoadAnswer
End Sub
Sub cmdNext_Click()
Call RecordAnswer
Call RestrictInput
If intCurrentQuestion = Item.Mileage - 1 Then
MsgBox "At last question"
Exit Sub
End If
intCurrentQuestion = intCurrentQuestion + 1
ShowQuestion (intCurrentQuestion)
Call updateqinfo
Call LoadAnswer
End Sub
Sub LoadAnswer()
If aryAnswers(intCurrentQuestion) = "" Then Exit Sub
Select Case strCurrentQuestionType
Case "Text"
txtAnswer.Text = aryAnswers(intCurrentQuestion)
Case "Y/N"
If aryAnswers(intCurrentQuestion) = optYes.Caption Then
optYes.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optNo.Caption Then
optNo.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optNA.Caption Then
optNA.Value = True
End If
Case "Agree Scale"
If aryAnswers(intCurrentQuestion) = optStrDisagree.Caption Then
optStrDisagree.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optDisagree.Caption Then
optDisagree.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optNeutral.Caption Then
optNeutral.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optAgree.Caption Then
optAgree.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optStrAgree.Caption Then
optStrAgree.Value = True
End If
Case "Choice"
If aryAnswers(intCurrentQuestion) = optchoice1.Caption Then
optchoice1.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optchoice2.Caption Then
optchoice2.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optchoice3.Caption Then
optchoice3.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optchoice4.Caption Then
optchoice4.Value = True
ElseIf aryAnswers(intCurrentQuestion) = optchoice5.Caption Then
optchoice5.Value = True
End If
Case "1-10"
txtRate.Text = aryAnswers(intCurrentQuestion)
End Select
End Sub
Sub cmdFinish_Click()
Dim objReply
Call RecordAnswer
Set objReply = Item.Reply
Set myresponse = Application.CreateItem(0)
Set objRecipResponse = myresponse.Recipients.Add(objReply.To)
objRecipResponse.Resolve
If Not objRecipResponse.Resolved Then
objRecipResponse.Delete
' assume it's an Internet address
Set objRecipReply = objReply.Recipients.Item(1)
strAddress = objRecipReply.Address
If strAddress = "" Then
strAddress = objRecipReply.Name
End If
strAddress = "[" & objRecipReply.AddressEntry.Type & ":" & _
strAddress & "]"
Set objRecipResponse = myresponse.Recipients.Add(strAddress)
objRecipResponse.Resolve
End If
objReply.Close 1
myresponse.Subject = "Survey Answers for " & Item.Subject
For I = 0 To Item.Mileage - 1
myresponse.Body = myresponse.Body & "Q" & CStr(I + 1) & ": " & aryQuestions(I) & Chr(13)
myresponse.Body = myresponse.Body & "A" & CStr(I + 1) & ": " & aryAnswers(I) & Chr(13)
myresponse.Body = myresponse.Body & Chr(13)
Next
If Item.UserProperties.Find("csvon") <> 0 Then
myresponse.Body = myresponse.Body & Chr(13) & Chr(13)
myresponse.Body = myresponse.Body & "CSV Format: " & Chr(13)
For I = 0 To Item.Mileage - 1
strcsvanswers = strcsvanswers & Chr(34) & aryAnswers(I) & Chr(34) & "|"
Next
strcsvanswers = Left(strcsvanswers, Len(strcsvanswers) - 1)
myresponse.Body = myresponse.Body & strcsvanswers
End If
myresponse.Send
Item.Delete
MsgBox "Your response has been sent. Thank you for participating."
End Sub
Sub Item_CustomPropertyChange(ByVal Name)
If Name = "onetype" Then
If Item.UserProperties.Find("onetype") = "Choice" Then
txtChoices.Visible = True
lblchoices.Visible = True
Else
txtChoices.Visible = False
lblchoices.Visible = False
End If
End If
End Sub
So the few things I'm trying to figure out are, how do I make multiple inputs for a single question? For example when I answer a question in this form, I am able to choose the type of question being asked and will provide a way to answer (text, choice, scale, y/n). What if I have a question like, "What is your favorite color?" and the choices are red, blue, green, other. When the users chooses "other" a text box prompts them to enter their favorite color. (yes, I know, horrible example)
My second question is how do I set up my scale to prompt a text box if they enter a certain choice. For example, if I asked users to rate our department on a scale of 1-10, and if the users chooses anything below 5 then we prompt them to enter a comment.
Once again, I have very limited VBS knowledge. I tend to play around with the code a lot and see if it works. If you look at my code carefully you can see that I changed the AgreeScale to a 1-10 scale.(shows how bad I am)
Hopefully I was clear on my questions. Thanks in advance!