'This is just like the Printable Page example in the text, except that the
'PrintablePage procedure is changed so that in addition to creating a printable
'slide, the results are also written to a text file.
Dim numCorrect As Integer
Dim numIncorrect As Integer
Dim userName As String
Dim q1Answered As Boolean
Dim q2Answered As Boolean
Dim q3Answered As Boolean
Dim answer1 As String
Dim answer2 As String
Dim answer3 As String
Dim answerFile

Sub GetStarted()
    Initialize
    YourName
    ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Initialize()
    numCorrect = 0
    numIncorrect = 0
    q1Answered = False
    q2Answered = False
    q3Answered = False
End Sub

Sub YourName()
    userName = InputBox(Prompt:="Type your name")
End Sub

Sub DoingWell()
    MsgBox ("You are doing well, " & userName)
End Sub

Sub DoingPoorly()
    MsgBox ("Try to do better next time, " & userName)
End Sub

Sub Answer1GeorgeWashington()
    If q1Answered = False Then
        numCorrect = numCorrect + 1
        answer1 = "George Washington"
    End If
    q1Answered = True
    DoingWell
    ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Answer1AbrahamLincoln()
    If q1Answered = False Then
        numIncorrect = numIncorrect + 1
        answer1 = "Abraham Lincoln"
    End If
    q1Answered = True
    DoingPoorly
End Sub

Sub Answer2Two()
    If q2Answered = False Then
        numCorrect = numCorrect + 1
        answer2 = "2" 'ADDED
    End If
    q2Answered = True
    DoingWell
    ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub Answer2Four()
    If q2Answered = False Then
        numIncorrect = numIncorrect + 1
        answer2 = "4"
    End If
    q2Answered = True
    DoingPoorly
End Sub

Sub Question3()
    Dim answer
    
    'This is the normal input box stuff
    answer = InputBox(Prompt:="What is the capital of Maryland?", _
        Title:="Question 3")
    
    'If this is the first time they answered, remember this answer
    'in answer3
    If q3Answered = False Then 'ADDED
        answer3 = answer 'ADDED
    End If 'ADDED
    answer = Trim(answer)
    answer = LCase(answer)

    'Check to see if they got the right answer
    If answer = "annapolis" Then
        RightAnswer3
    Else
        WrongAnswer3
    End If
End Sub

Sub RightAnswer3()
    If q3Answered = False Then
        numCorrect = numCorrect + 1
    End If
    q3Answered = True
    DoingWell
    ActivePresentation.SlideShowWindow.View.Next
End Sub

Sub WrongAnswer3()
    If q3Answered = False Then
        numIncorrect = numIncorrect + 1
    End If
    q3Answered = True
    DoingPoorly
End Sub

Sub PrintablePage()
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim fs, f
    Dim printableSlide As Slide
    Dim homeButton As Shape
    Dim printButton As Shape
    
    Set printableSlide = ActivePresentation.Slides.Add(Index:=6, _
        Layout:=ppLayoutText)
    printableSlide.Shapes(1).TextFrame.TextRange.Text = _
        "Results for " & userName
    printableSlide.Shapes(2).TextFrame.TextRange.Text = _
        "Your Answers" & Chr$(13) & _
        "Question 1: " & answer1 & Chr$(13) & _
        "Question 2: " & answer2 & Chr$(13) & _
        "Question 3: " & answer3 & Chr$(13) & _
        "You got " & numCorrect & " out of " & _
        numCorrect + numIncorrect & "." & Chr$(13) & _
        "Press the Print Results button to print your answers."
    
    'Stuff added to write answers to a file named myTestFile.txt
    'To create a new text file named answers.txt, instead of appending
    'to an existing file uncomment the first "Set answerFile" line and
    'comment the second (2nd and 3rd lines below)
    Set fs = CreateObject("Scripting.FileSystemObject")
    'Set answerFile = fs.CreateTextFile(userName & "answers.txt", True)
    Set answerFile = fs.OpenTextFile("myTestFile.txt", ForAppending, False)
    answerFile.WriteLine _
        "Results for " & userName
    answerFile.WriteLine _
        "Your Answers"
    answerFile.WriteLine _
        "Question 1: " & answer1
    answerFile.WriteLine _
        "Question 2: " & answer2
    answerFile.WriteLine _
        "Question 3: " & answer3
    answerFile.WriteLine _
        "You got " & numCorrect & " out of " & _
        numCorrect + numIncorrect & "."
    answerFile.Close
    
    Set homeButton = ActivePresentation.Slides(6).Shapes.AddShape _
        (msoShapeActionButtonCustom, 0, 0, 150, 50)
    homeButton.TextFrame.TextRange.Text = "Start Again"
    homeButton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
    homeButton.ActionSettings(ppMouseClick).Run = "StartAgain"
    Set printButton = ActivePresentation.Slides(6).Shapes.AddShape _
        (msoShapeActionButtonCustom, 200, 0, 150, 50)
    printButton.TextFrame.TextRange.Text = "Print Results"
    printButton.ActionSettings(ppMouseClick).Action = ppActionRunMacro
    printButton.ActionSettings(ppMouseClick).Run = "PrintResults"
    ActivePresentation.SlideShowWindow.View.Next
    ActivePresentation.Saved = True
End Sub

Sub PrintResults()
    ActivePresentation.PrintOptions.OutputType = ppPrintOutputSlides
    ActivePresentation.PrintOut From:=6, To:=6
End Sub

Sub StartAgain()
    ActivePresentation.SlideShowWindow.View.GotoSlide (1)
    ActivePresentation.Slides(6).Delete
    ActivePresentation.Saved = True
End Sub