exporting xml file from pass through query (1 Viewer)

Private Sub btnExportXML_Click()
'http://forums.augi.com/showthread.php?125024-Create-XML-file-using-VBA
'Output selected Product Code back to xml format
'after making corrections
'20150506
     
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim stsql As String
    Dim stProductCode As String
    Dim stQuestionNumber As String
    Dim stFolder As String
    Dim i As Integer
    Dim xmlFile
    
    If IsNull(Me.cboProductCode) Then
        MsgBox "Please choose a product code and then export to xml", vbOKOnly, "Missing Product Code"
        GoTo Exitsub
    End If
    Me.lblExportXMLNote.Visible = True
    xmlFile = DLookup("FileLocation", "tblFileLocations", "FileType='xml Files'") & Me.cboProductCode & ".xml"
    If Dir(xmlFile) <> "" Then
        yesno = MsgBox("File exists.  Overwrite / Replace / New Location?", vbYesNoCancel, "File Exists")
        If yesno = vbNo Then
            GoTo Exitsub
        ElseIf yesno = vbCancel Then
            stFolder = selectFolder
            xmlFile = stFolder & "\" & Me.cboProductCode & ".xml"
        End If
    End If
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT * FROM xmlExam where ProductCode='" & Me.cboProductCode & "'")
    
    rs.MoveFirst
    stQuestionNumber = rs!questionNumber
    Open xmlFile For Output As #1
    Print #1, "<?xml version=" & Chr(34) & "1.0" & Chr(34) & _
          " encoding=" & Chr(34) & "utf-8" & Chr(34) & "?>"
          '' <  add xml-schema if it's needed here >
    Print #1, "<test ProductCode=" & Chr(34) & rs!ProductCode & Chr(34) & " Category=" & Chr(34) & rs!Category & Chr(34) & " displayQuestions=" & Chr(34) & rs!displayQuestions & Chr(34) & " passMinimum=" & Chr(34) & rs!passMinimum & Chr(34) & ">"
    Print #1, "  <questions>"
    Print #1, "    <question text=" & Chr(34) & ReplaceHTML(rs!text1) & Chr(34) & " questionNumber=" & Chr(34) & rs!questionNumber & Chr(34) & ">"
    Print #1, "      <options>"
        
    Do While Not rs.EOF
        If rs!questionNumber = stQuestionNumber Then
            If rs!correct = True Then
                stCorrect = " correct=" & Chr(34) & LCase(rs!correct) & Chr(34)
            Else
                stCorrect = ""
            End If
            Print #1, "        <option type=" & Chr(34) & rs!type & Chr(34) & " text=" & Chr(34) & ReplaceHTML(rs!Text2) & Chr(34) & stCorrect & " />"
            rs.MoveNext
        Else
            Print #1, "      </options>"
            Print #1, "    </question>"
            Print #1, "    <question text=" & Chr(34) & ReplaceHTML(rs!text1) & Chr(34) & " questionNumber=" & Chr(34) & rs!questionNumber & Chr(34) & ">"
            Print #1, "      <options>"
            stQuestionNumber = rs!questionNumber
        End If
    Loop
    
    Print #1, "      </options>"
    Print #1, "    </question>"
    Print #1, "  </questions>"
    Print #1, "</test>"
    Close #1
    rs.Close
    Set rs = Nothing
    Set db = Nothing
    If DCount("ProductCode", "XMLExamOut", "ProductCode='" & stTableName & "'") = 0 Then
        stsql = "INSERT INTO XMLExamOUT ( ProductCode ) " & _
                "SELECT XMLExam.ProductCode " & _
                "FROM XMLExam " & _
                "WHERE [productcode]='" & [Forms]![frmmain].[cboProductCode] & "' "
        CurrentDb.Execute stsql
    End If
Exitsub:
    Me.lblExportXMLNote.Visible = False
End Sub