VBA code that reads a txt file, places specified words into columns

I'm trying to write a VBA macro that will read through a text document and place specific words into columns. UPDATE: Here's a sample of the file, apparently it's XML, so at least I learned something new today. So i guess what I need is a program to shed the XML parts, and place just the text into columns.

<Alarm>
<ID>1002</ID>
<Type>Fault</Type>
<Message>Bad Brake</Message>
<Tagname>error.e2</Tagname>
</Alarm>
<Alarm>
<ID>1004</ID>
<Type>Fault</Type>
<Message>No Motion</Message>
<Tagname>error.e4</Tagname>
</Alarm>
<Alarm>
<ID>1005</ID>
<Type>Fault</Type>
<Message>Upper safety door open</Message>
<Tagname>error.e5</Tagname>
</Alarm>

Ultimately, I'm trying to put the 4 digit error codes in column A (i.e. 1002, 1004...), and the error message in column B (i.e. Bad Brake, No motion....). I'll paste what I have so far, I tried coding it for just one pair of data to start. I'm stuck trying to get the error message into column B. The error messages all start in the same position on each line, but I can't figure out how to stop copying the text, since each error message is a different length of characters. Any ideas?

(P.S. - I apologize if the code is terrible, I've been interning as an electrical engineer, so my programming has gotten rather rusty.)

Private Sub CommandButton1_Click()

Dim myFile As String, textLine As String, ID As Integer, error_msg As Integer

myFile = "C:\Users\scholtmn\Documents\Projects\Borg_Warner_txt_file\BW_fault_codes.txt"

Open myFile For Input As #1
Do Until EOF(1)
Line Input #1, textLine
Text = Text & textLine
Loop
Close #1

ID = InStr(Text, "<ID>")
error_msg = InStr(Text, "<Message>")

Range("A1").Value = Mid(Text, ID + 4, 4)
Range("B1").Value = Mid(Text, error_msg + 9, (InStr(Text, " <") - 31))



End Sub

Solution

Please, try the next code:

Sub ExtractErrorsDefinition()
   'it needs a reference to 'Microsoft XML, v6.0'
   Dim XMLFileName As String, oXMLFile As New MSXML2.DOMDocument60, sh As Worksheet
   Dim N As MSXML2.IXMLDOMNode, i As Long, arr
   
   Set sh = ActiveSheet 'use here the necessary sheet
   
   XMLFileName = "the full text file path" '"C:\Utile\Teste Corel\XMLtext.txt"
   oXMLFile.Load (XMLFileName)
   
   ReDim arr(1 To oXMLFile.SelectNodes("AlarmDictionary/Alarm").length, 1 To 2): i = 1
   For Each N In oXMLFile.SelectNodes("AlarmDictionary/Alarm")
        arr(i, 1) = N.SelectSingleNode("ID").Text: arr(i, 1) = N.SelectSingleNode("Message").Text: i = i + 1
  Next
  sh.Range("A2").Resize(UBound(arr), 2).value = arr
End Sub

It may work using late binding, but it is better to have the intellisense suggestion, especially when not very well skilled in working with XML.

If looks complicated to add such a reference, I can add a piece of code to automatically add it.

Please, run the next code to automatically add the necessary reference. Save your workbook and run the first code after:

Sub addXMLRef()
  'Add a reference to 'Microsoft Scripting Runtime':
  'In case of error ('Programmatic access to Visual Basic Project not trusted'):
  'Options->Trust Center->Trust Center Settings->Macro Settings->Developer Macro Settings->
  '         check "Trust access to the VBA project object model"
  Application.VBE.ActiveVBProject.References.AddFromFile "C:\Windows\System32\msxml6.dll"
End Sub