XML/Text file find/add (1 Viewer)

<T_COMMENTS>
	<COMMENT_NO>Comment 1</COMMENT_NO>
	<STATUS>Old</STATUS>
	<USER>User1</USER>
	<COMMENT>blah blah blah</COMMENT>
</T_COMMENTS>
<T_COMMENTS>
	<COMMENT_NO>Comment 2</COMMENT_NO>
	<STATUS>Old
	<USER>User2</USER>
	<COMMENT>asfjhewlfjkhasdlfkjhasdlfkj</COMMENT>
</T_COMMENTS>

Sub FixTags(filename As String)
Dim fso As New FileSystemObject
Dim ts As TextStream
Set ts = fso.OpenTextFile(filename, ForReading)
Dim ThisLine As String
Dim i As Integer
i = 0
Do Until ts.AtEndOfStream
ThisLine = ts.ReadLine
i = i + 1
'Debug.Print "Line " & i, ThisLine

    If Left(9, ThisLine) = "<STATUS>" And Right(1, ThisLine) <> ">" Then
        ThisLine = ThisLine & " </STATUS>"
    Else
    End If
        
Loop
ts.Close
End Sub

Option Compare Database
Option Explicit

Private mRst As ADODB.Recordset

Private Sub FixXMLTags()

    Dim strFile As String
    strFile = CurrentProject.Path & "\CorrectionTest.xml"
    
    Dim blnProceed As Boolean
    blnProceed = GetXMLFile(strFile)
    
    If Not blnProceed Then
        Exit Sub
    End If
    
    Call SetXMLFile(strFile)
    
    mRst.Close
    Set mRst = Nothing
    
End Sub

Private Function GetXMLFile( _
    ByVal strXMLFile As String) As Boolean
    
On Error GoTo Err_Get
    
    GetXMLFile = False

    Dim blnProceed As Boolean
    blnProceed = InitializeRecordset

    If Not blnProceed Then
        Exit Function
    End If
    
    Open strXMLFile For Input As #1
    

    Dim strLine As String
    
    While Not EOF(1)
        Line Input #1, strLine
        
        If Left(strLine, 9) = Chr(9) & "<STATUS>" And Right(strLine, 1) <> ">" Then
            strLine = strLine & "</STATUS>"
        End If

        mRst.AddNew Array(0), Array(strLine)
    Wend
    
    GetXMLFile = True
    
Exit_Get:
    Close #1
    Exit Function
    
Err_Get:
    MsgBox Err.Description
    Resume Exit_Get

End Function

Private Function InitializeRecordset() As Boolean
On Error GoTo Err_Ini

    InitializeRecordset = False
    
    Set mRst = New ADODB.Recordset
    
    ' (You have to adapt the field size - here '100' - to your requirements!)
    mRst.Fields.Append "Line", adVarChar, 100, adFldUpdatable
    mRst.Open
    
    InitializeRecordset = True
    
Exit_Ini:
    Exit Function
    
Err_Ini:
    MsgBox Err.Description
    Resume Exit_Ini
    
End Function

Private Function SetXMLFile( _
    ByVal strXMLFile As String) As Boolean

On Error GoTo Err_Set

    SetXMLFile = False
    
    Open strXMLFile For Output As #1
    
    mRst.MoveFirst
    
    Do
        Print #1, mRst(0).Value
        mRst.MoveNext
    Loop While Not mRst.EOF

    SetXMLFile = True
    
Exit_Set:
    Close #1
    Exit Function

Err_Set:
    MsgBox Err.Description
    Resume Exit_Set

End Function

    If Not Dir(strFile) = vbNullString Then
        Kill strFile
    End If