LISTING 3: VB Form frmXMLTester.frm

Dim xmlDoc As MSXML.DOMDocument

Dim objNodeList As MSXML.IXMLDOMNodeList
Dim objNode As MSXML.IXMLDOMNode
Dim objAttribute As MSXML.IXMLDOMAttribute
Dim objNodeMap As MSXML.IXMLDOMNamedNodeMap
Dim objNamedItem As MSXML.IXMLDOMNode

Dim objDocElement As MSXML.IXMLDOMElement

Dim sXML As String

Const iRecordsToProcess As Integer = 5

Const XMLVersion As String = "<?xml version=""1.0""?>"

Const BookStartTag As String = "<Books>"
Const BookEndTag As String = "</Books>"
Const BookTagName As String = "Book"

Dim ofs As FileSystemObject
Dim oTS As TextStream
Dim oFile As File

Function GetDSN() As String
    
    GetDSN = "Provider=SQLOLEDB;Data Source=bigboat;Initial Catalog=pubs;User Id=sa" & ";Password=;"
    Exit Function
        
End Function

'Callout A
Function ProcessInComingFile(FileToProcess As String)
Dim i As Integer, sText As String, sAllText As String
'Callout B
    Set ofs = New FileSystemObject
    Set xmlDoc = New MSXML.DOMDocument
          
    Set oFile = ofs.GetFile(FileToProcess)
'End Callout B
    i = 0
    sAllText = XMLVersion & BookStartTag
    Set oTS = oFile.OpenAsTextStream(ForReading)
        Do While Not oTS.AtEndOfStream
'Callout C
            If i = iRecordsToProcess Then
                i = 0
                sAllText = sAllText & BookEndTag
                xmlDoc.async = False
                xmlDoc.loadXML (sAllText)
                OutputData
                sAllText = XMLVersion & BookStartTag
            End If
'End Callout C
            sText = oTS.ReadLine
            If InStr(sText, XMLVersion) = 0 And InStr(sText, BookStartTag) = 0 Then
                sAllText = sAllText & sText
                i = i + 1
            End If
        Loop
    oTS.Close

End Function
'End Callout A

Private Function OutputData()
Dim i As Integer
Dim sNodeIDToFind As String
Dim sNodeToFind As String
Dim sTitleID As String
Dim sTitle As String
Dim sNotes As String
Dim sSQL As String
Dim cmd As ADODB.Command
    
    Set cmd = CreateObject("ADODB.Command")
    
    cmd.ActiveConnection = GetDSN()
        
'Callout D
    sNodeToFind = BookTagName
    
    Set objNodeList = xmlDoc.getElementsByTagName(sNodeToFind)
    
    For i = 0 To (objNodeList.length - 1)
        
        Set objNode = objNodeList.nextNode
        Set objNodeMap = objNode.Attributes
        
        Set objNamedItem = objNodeMap.getNamedItem("TitleID")
        sTitleID = objNamedItem.Text
        
        Set objNamedItem = objNodeMap.getNamedItem("Title")
        sTitle = objNamedItem.Text
        
        Set objNamedItem = objNodeMap.getNamedItem("Notes")
        sNotes = objNamedItem.Text
'End Callout D
       
        sSQL = "exec IinsertTitleNew " & Chr(34) & sTitleID & Chr(34) & "," & Chr(34) & sTitle & Chr(34) & "," & Chr(34) & "New type" & Chr(34) & "," & Chr(34) & sNotes & Chr(34)
        
        cmd.CommandText = sSQL
        cmd.CommandType = adCmdText
        
        cmd.Execute , , ADODB.adExecuteNoRecords
        
        Debug.Print sSQL
        On Error GoTo 0
    Next
       
    Set cmd.ActiveConnection = Nothing
    Set cmd = Nothing


End Function