Printing respondent answers from a Data Management Script

It’s been a while since our last article on printing to word, but we thought that we should continue as we have completed some more work on this. In this article you will see how to take the code that has already been written and use it inside of a DMS script to produce a word document for every record.

To start us off we need a dms script. It’s a simple script at this stage just an input and an output section.

InputDatasource(Input, "")
    ConnectionString = "Provider=mrOleDB.Provider.2;Data Source=mrDataFileDsc;
         Location=C:ReportsSurvey.ddf;Initial Catalog=C:ReportsSurvey.mdd;
         MR Init MDM Access=1" 
    SelectQuery = "SELECT * FROM VDATA"
End InputDatasource

OutputDatasource(Output, "")
    UseInputAsOutput = true
End OutputDatasource

You can see here that in our Output section we have added a property UseInputAsOutput and set it to true. What this means is that we will not be making any changes to the data at all and we don’t want to produce an output file. When this part of our script is working we need to add an On Next case Event. This event will be where we place our code to take each respondents answers and place them in the word document. To start with our event will look like this,

Event(OnNextCase, "")
if ( Respondent.serial > 10 ) Then
 ' Set the survey Answers
 Dim oWord,sFileName
 Set oWord = CreateObject("Word.Application")
 oWord.visible = true

 ' These lines will use a template and show results
 oWord.Documents.Open("C:ReportsTEMPLATE.docx")
 RunTemplate(oWord,dmgrjob,True)
  oWord.DisplayAlerts = false
  sFileName = "C:Reports" + CTEXT(respondent.serial) + "_" + Clean(s_OrganisationName) +  ".docx"
  oWord.ActiveDocument.SaveAs(sFileName)
  oWord.Quit()
End If

End Event

So what have we done , will we have simply taken the first part of our code from the previous articles and edited it so that it will work inside a DMS. Oh , and we added an if statement around it on the respondent.serial so that you can manage the running of the script if you only want to pull out certain records. One thing that you should note is that inside of a DMS file we don’t have the IOM object , but we do have a similar object called dmgrjob, so you can see that we have passed that in to our run template instead.

Next After the End if we need to add our all the functions that we have created previously. The code that we used previously is a little out of date now , due to some updates so you can just copy all this code if you like.

Function Clean(sString)
  sString = replace(sString,"?","")
  Clean = sString
 End Function

Sub MakeSpace(oWord)
 ' Jump out of table
 oWord.Selection.MoveDown(7,1)
 ' Insert New line
 oWord.Selection.TypeParagraph()
End Sub

Sub StepOut(oWord)
 oWord.Selection.MoveRight(12)
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 MakeNumGridTable(oWord,sLabel)
    oWord.ActiveDocument.Tables.Add(oWord.Selection.range,1,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
    oWord.Selection.MoveRight(12)
    oWord.Selection.Cells.Split(1,2,True)

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
         If ( bWithAnswers ) Then
    GetAnswers(oQuestion,"G","",oWord)
   Else
         MakeSpace(oWord)
    MakeTable(oWord,oQuestion.Label)
    CreateQuestions(oQuestion,"G","",oWord,0,IOM)
   End If
  Case 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,"B","",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 = 0
     ' Info item : do nothing
       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 + ":" + _
          oOther.Name + ":OtherTextX",oOTher.OtherQuestion.response.value)
           Next
      End Select
     Case = "B"
      ' TODO Will not work for nested Blocks
      For each oItem in oQuestion
       'If ( Find(oItem.ParentQuestion.QuestionFullname,".") > -1 ) Then
           GetAnswers(oItem,"S",oQuestion.Label,oWord)
          'Else
          ' GetAnswers(oItem,"B",oQuestion.Label,oWord)
       'End If
       Next

     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 = 0
     ' I am an info item so i just need to step out the box
     StepOut(oWord)
       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
              ' What code goes here ???
      debug.Log("DO SOMETHING")
        If ( iQCount = 2 ) Then
         AddSplitRowToTable(oWord,oQuestion.Label,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + "X",1,2)
     Else
      Add2RowToTable(oWord,oQuestion.Label,oIOM.Questions[oQuestion.ParentQuestion.ParentQuestion.QuestionName].categories[oQuestion.ParentQuestion.QuestionName].label,"X" + oQuestion.QuestionFullName + "X")
              End If
          Case = 0
     ' I am an info item so i just need to step out the box
     ' StepOut(oWord)
     debug.Log("WHY AM I HERE")
       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

And there you have it when you run your DMS script against your data files you will get a word document for each. In our next article on this topic we will begin to look at how we can start to add the logic our routing into the document.

3 thoughts on “Printing respondent answers from a Data Management Script”

  1. To get the multiple categorical questions to work, I had to make the following change:

    I chaged the line: ‘If ( oCat.Value.Format(“a”) = oQuestion.Response.Value.Format(“a”) ) Then

    to:

    If ( oQuestion.Response.Value.ContainsAny(oCat.Value) ) Then

  2. One other thing I noticed and I’ll post my workaround when it’s finished, but it looks like the replace function in Word only supports 255 characters, so if you have a text response longer than that, this script as is will throw an error.

Leave a Comment

%d bloggers like this: