Many moons ago , i needed to make a script that showed the users answer in a word doc. This JustCode script shows you how you can do it. Its creates a template for you and populates it.
Routing(Web)
' Set the survey Answers
Single = {A}
Multi = {A,B}
ToDaysDate="04/06/2010"
GridQuestion[{Sub1}].SingleCategoricalQuestionName = {A}
GridQuestion[{Sub2}].SingleCategoricalQuestionName = {B}
GridQuestion[{Sub3}].SingleCategoricalQuestionName = {C}
GridQuestion[{Sub4}].SingleCategoricalQuestionName = {D}
GridQuestion[{Sub5}].SingleCategoricalQuestionName = {E}
DoubleQuestioName = 12.12
LongQuestionName = 122
TextQuestionName = "This is a text question"
SingleWithOther._Other = "hello"
SingleWithOther = {_other}
Dim oWord,sFileName
Set oWord = CreateObject("Word.Application")
oWord.visible = true
' These two lines will make a template for us.
'oWord.Documents.Add()
'RunTemplate(oWord,IOM,False)
' These lines will use a template and show results
oWord.Documents.Open("D:DATASDLibraryPrintToWordSimpleTemplate.docx")
RunTemplate(oWord,IOM,True)
oWord.DisplayAlerts = false
'sFileName = "c:temp" + replace(replace(CText(DateNow()),"/","_"),":","_") + ".docx"
'oWord.ActiveDocument.SaveAs(sFileName)
oWord.Quit()
Sub MakeSpace(oWord)
' Jump out of table
oWord.Selection.MoveDown(5,1)
' Insert New line
oWord.Selection.TypeParagraph()
End Sub
Sub MakeTable(oWord,sLabel)
oWord.ActiveDocument.Tables.Add(oWord.Selection.range,2,1,1,0)
With oWord.Selection.Tables[1]
If .Style <> "Table Grid" Then
.Style = "Table Grid"
End If
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = False
.ApplyStyleRowBands = True
.ApplyStyleColumnBands = False
End With
oWord.Selection.Text = sLabel
End Sub
Sub Add2RowToTable(oWord,sLabel,sAnswerLabel,sAnswer)
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer
End Sub
Sub Add1RowToTable(oWord,sLabel,sAnswerLabel,sAnswer)
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer
End Sub
Sub AddSplitRowToTable(oWord,sLabel,sAnswerLabel,sAnswer,iRows,iCols)
oWord.Selection.MoveRight(12)
oWord.Selection.Cells.Split(iRows,iCols,True)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sAnswer
End Sub
Sub AddGridSplitRowToTable(oWord,sLabel,sAnswerLabel,sAnswer,iRows,iCols)
oWord.Selection.MoveRight(12)
oWord.Selection.Cells.Split(iRows,iCols,True)
oWord.Selection.Text = sAnswerLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer
End Sub
Sub AddGridRowToTable(oWord,sAnswer)
oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer
End Sub
Sub AddNextGridRowToTable(oWord,sLabel,sAnswer)
oWord.Selection.MoveRight(12)
oWord.Selection.Text = sLabel
oWord.Selection.MoveRight(12)
oWord.Selection.Font.Size = 2
oWord.Selection.Text = sAnswer
End Sub
Sub RunTemplate(oWord,IOM,bWithAnswers)
Dim oQuestion
For Each oQuestion in IOM.Questions
Select Case oQuestion.QuestionType
Case QuestionTypes.qtSimple
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"S","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"S","",oWord,0,IOM)
End If
Case QuestionTypes.qtLoopCategorical, QuestionTypes.qtLoopNumeric
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"G","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"G","",oWord,0,IOM)
End If
Case QuestionTypes.qtBlock, QuestionTypes.qtCompound, QuestionTypes.qtPage
If ( bWithAnswers ) Then
GetAnswers(oQuestion,"G","",oWord)
Else
MakeSpace(oWord)
MakeTable(oWord,oQuestion.Label)
CreateQuestions(oQuestion,"G","",oWord,0,IOM)
End If
End Select
Next
End Sub
Sub FindAnswer(oWord,sLookingFor,sValue)
With oWord.Selection.Find
.Text = sLookingFor
.Replacement.Text = sValue
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
oWord.Selection.Find.Execute(,,,,,,,,,,1,,,,)
oWord.Selection.Font.Size = 10
oWord.Selection.HomeKey(6)
End Sub
Sub GetAnswers(oQuestion,sType,sLabel,oWord)
Dim oCat,oItem,oOther
Select Case sType
Case = "S"
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + "X",oQuestion.Response.Value)
Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + "X",oQuestion.Response.Value)
Case Else
For each oCat in oQuestion.Categories
If ( oCat.Value.Format("a") = oQuestion.Response.Value.Format("a") ) Then
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X","Yes")
Else
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X","No")
End If
Next
' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
FindAnswer(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + ":OtherTextX",oOTher.OtherQuestion.response.value)
Next
End Select
Case = "G"
For each oItem in oQuestion
If ( Find(oItem.ParentQuestion.QuestionFullname,"{") > -1 ) Then
GetAnswers(oItem,"S",oQuestion.ParentQuestion.Label,oWord)
Else
GetAnswers(oItem,"G",oQuestion.Label,oWord)
End If
Next
End Select
End Sub
Sub CreateQuestions(oQuestion,sType,sLabel,oWord,iQCount,oIOM)
Dim oCat,oItem,oOther,iCat
Select Case sType
Case = "S"
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
If ( sLabel = "" ) Then
Add1RowToTable(oWord,oQuestion.Label,"","X" + oQuestion.QuestionFullName + "X")
Else
Add1RowToTable(oWord,oQuestion.Label,"","X" + sLabel + "X")
End If
Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText
If ( sLabel = "" ) Then
Add1RowToTable(oWord,oQuestion.Label,"","X" + oQuestion.QuestionFullName + "X")
Else
Add1RowToTable(oWord,oQuestion.Label,"","X" + sLabel + "X")
End If
Case Else
iCat = 0
For each oCat in oQuestion.Categories
If iCat = 0 Then
If ( sLabel = "" ) Then
AddSplitRowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,2)
Else
AddSplitRowToTable(oWord,sLabel,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,2)
End If
Else
If ( sLabel = "" ) Then
Add2RowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
Add2RowToTable(oWord,sLabel,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If
End If
iCat = iCat + 1
Next
' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
If ( sLabel = "" ) Then
Add2RowToTable(oWord,oQuestion.Label,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
Else
Add2RowToTable(oWord,sLabel,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
End If
Next
End Select
Case = "GS"
'MakeTable(oWord,oQuestion.Label)
Select Case oQuestion.QuestionDataType
Case = DataTypeConstants.mtDate
Case = DataTypeConstants.mtBoolean,DataTypeConstants.mtDouble, _
DataTypeConstants.mtLong,DataTypeConstants.mtText
Case Else
iCat = 0
For each oCat in oQuestion.Categories
If iCat = 0 Then
If ( iQCount = 2 ) Then
If ( sLabel = "" ) Then
AddGridSplitRowToTable(oWord,oQuestion.Label,oCat.Label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,oQuestion.Categories.count+1)
Else
AddGridSplitRowToTable(oWord,sLabel,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X",1,oQuestion.Categories.count+1)
End If
Else
'At This stage i need to know
'oIOM.Questions["GridQuestion"].categories["Sub1"].label
If ( sLabel = "" ) Then
AddNextGridRowToTable(oWord,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
AddNextGridRowToTable(oWord,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If
End If
Else
If ( sLabel = "" ) Then
AddGridRowToTable(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
Else
AddGridRowToTable(oWord,"X" + oQuestion.QuestionFullName + ":" + _
oCat.Name + "X")
End If
End If
iCat = iCat + 1
Next
' Do we have Other Responses
For Each oOther in oQuestion.OtherCategories
If ( sLabel = "" ) Then
AddSimpleTable(oWord,oQuestion.Label,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
Else
AddSimpleTable(oWord,sLabel,oOther.Label,"X" + oQuestion.QuestionFullName + ":" + _
oOther.Name + ":OtherTextX")
End If
Next
End Select
Case = "G"
For each oItem in oQuestion
iQCount = iQCount + 1
If ( Find(oItem.ParentQuestion.QuestionFullname,"{") > -1 ) Then
CreateQuestions(oItem,"GS",oQuestion.ParentQuestion.Label,oWord,iQCount,oIOM)
Else
CreateQuestions(oItem,"G",oQuestion.Label,oWord,iQCount,oIOM)
End If
Next
End Select
End Sub
End Routing
Like this:
Like Loading...