XML Import (1 Viewer)

Sub ImportXMLFile(myFileName As String)
    Dim strLine As String
    Dim rs As DAO.Recordset, ColNr As Integer, myFieldName As String
    Dim tagStart As Integer, tagLength As Integer, tagEnd As Integer
    Dim valStart As Integer, valLength As Integer
    Dim myFileID As Integer, RecordNummer As Double, LineNr As Double
    Dim TotalRecords As String
    Dim LeadingTags As String, ThisTag As String, ThisValue As Variant
    prevTag = ""
    
    Dim rsH As DAO.Recordset, rsD As DAO.Recordset
    
    Set rsH = CurrentDb.OpenRecordset("Select * from tblHeaders")
    Set rsD = CurrentDb.OpenRecordset("Select * from tblDetails")
    Open myFileName For Input As #1
    RecordNummer = 0
    LineNr = 0
    Line Input #1, strLine
    strLine = LTrim(strLine) ' FirstLine
    rsH.AddNew
    myFileID = Nz(DMax("FileID", "tblHeaders"), 0) + 1
    rsH!Fileid = myFileID
    rsH!FileName = myFileName
    rsH!processdate = Now()
    rsH!FirstLine = strLine
    Line Input #1, strLine
    LineNr = LineNr + 1
    strLine = LTrim(strLine) ' SecondLine
    rsH!SecondLine = strLine
    Line Input #1, strLine
    LineNr = LineNr + 1
    strLine = LTrim(strLine) ' first nest, start loop
    
    TotalRecords = "?"
    Forms("frmImport").lblProgress.Caption = RecordNummer & " / " & TotalRecords
    Forms("frmImport").lblProgress.Visible = True
    DoEvents
    
    Do While 1 = 1
        tagStart = InStr(1, strLine, "<") + 1
        tagLength = InStr(tagStart, strLine, ">") - tagStart
        tagEnd = tagLength
        valStart = tagStart + tagLength + 1
        valLength = InStr(valStart - 1, strLine, "<") - valStart
        ThisTag = Mid(strLine, tagStart, tagLength)
        ThisValue = Null
        If valLength > 0 Then
            ThisValue = Mid(strLine, valStart, valLength)
        Else
            If ThisTag = "/NearingEndXML" Then
                ' nearly end of the file, stop reading
                Exit Do
            ElseIf Left(ThisTag, 1) = "/" Then
                LeadingTags = Left(LeadingTags, Len(LeadingTags) - Len(ThisTag))
            ElseIf Right(ThisTag, 1) = "/" Then
                ' un-nesting tag
            Else
                ' nesting tag
                LeadingTags = LeadingTags & "/" & ThisTag
            End If
            ThisValue = Null
        End If
        If 1 = 2 Then
            ' dummy for formatting purposes
        ElseIf LeadingTags = "/SomeTag" Then
        ElseIf LeadingTags = "/SomeTag/SubTag" Then
            If 1 = 2 Then
                ' dummy for formatting purposes
            ElseIf ThisTag = "TagWithValue1" Then
                rsH.Fields(ThisTag) = ThisValue
            ElseIf ThisTag = "TagWithValue2" Then
                rsH.Fields(ThisTag) = ThisValue
            ElseIf ThisTag = "TagWithValue3" Then
                rsH.Fields(ThisTag) = ThisValue
                TotalRecords = ThisValue
                Forms("frmImport").lblProgress.Caption = RecordNummer & " / " & TotalRecords
                DoEvents
            ElseIf ThisTag = "CheckSum" Then
                rsH.Fields(ThisTag) = CDbl(Replace(ThisValue, ".", "")) / 100
            End If
        ElseIf LeadingTags = "SomeTag/SubTag/MoreTag" Then
            If 1 = 2 Then
                ' dummy for formatting purposes
            ElseIf ThisTag = "Name" Then
                ' there are more tags with name, so I prefix it with something to make it unique in the table.
                rsH.Fields("MoreTag" & ThisTag) = ThisValue
            End If
        ElseIf LeadingTags = ....
.... etc....
....
        ' cut off the current tag, so we can check for multiple tags on one line
        If valLength > 0 Then
            strLine = LTrim(Mid(strLine, tagLength + 3 + valLength))
        Else
            strLine = LTrim(Mid(strLine, tagLength + 3))
        End If
        If Left(strLine, tagEnd + 3) = "</" & ThisTag & ">" And valLength > 0 Then
            '   closing tag, hopefully we got a value
            strLine = LTrim(Mid(strLine, tagEnd + 4))
        End If
        If Len(strLine) = 0 Then
            ' nothing left on the line read the next
            Line Input #1, strLine
            LineNr = LineNr + 1
            strLine = LTrim(strLine)
        Else
        End If
'       for debugging only
'        DoEvents
'        Debug.Print "Line: " & strLine
'        Debug.Print "Tags: " & LeadingTags
'        Stop
    Loop
    rsH.Close
    rsD.Close
    Close #1
End Sub