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

Question

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

Answer 1

It looks like the txt file you are using is actually an xml file. If you changed the format, this piece of code I slightly adjusted from here should work fine.

Sub From_XML_To_XL()
    Dim xmlWb As Workbook, xSWb As Workbook, xStrPath$, xfdial As FileDialog, _
    xFile$, lr%, first As Boolean, r As Range
    first = True
    Set xfdial = Application.FileDialog(msoFileDialogFilePicker)
    xfdial.AllowMultiSelect = False
    xfdial.Title = "Select an XML File"
    If xfdial.Show = -1 Then xStrPath = xfdial.SelectedItems(1) & ""
    If xStrPath = "" Then Exit Sub
    Set xSWb = ThisWorkbook
    lr = xSWb.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row    ' last used row, column A
    xFile = xStrPath
    Set xmlWb = Workbooks.OpenXML(xFile)
    If first Then
        Set r = xmlWb.Sheets(1).UsedRange                         ' with header
    Else
        xmlWb.Sheets(1).Activate
        Set r = ActiveSheet.UsedRange
        Set r = Range(Cells(3, 1), Cells(r.Rows.Count, r.Columns.Count))
    End If
    r.Copy xSWb.ActiveSheet.Cells(lr + 1, 1)
    lr = xSWb.ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row
    xmlWb.Close False
    first = False
End Sub

I think you'll find this task a lot easier if you take advantage of the fact it is in XML format. You can find more information about working with XML in VBA here.

Answer 2

As Ben Mega already stated: you have an XML-File - why not use XML-functionality.

Add "Microsoft XML, v6.0" to your project references - then you can use this code

Public Sub insertTextFromXML()

Dim objXML As MSXML2.DOMDocument60
Set objXML = New MSXML2.DOMDocument60

If Not objXML.Load("T:\Stackoverflow\Test.xml") Then
    Err.Raise objXML.parseError.ErrorCode, , objXML.parseError.reason
End If
 
Dim nAlarm As MSXML2.IXMLDOMNode

'loop through all alarms and output ID plus message
For Each nAlarm In objXML.SelectNodes("AlarmDictionary/Alarm")
    With nAlarm
        Debug.Print .SelectSingleNode("ID").Text, .SelectSingleNode("Message").Text
    End With
Next

'Filter for ID 1004
Set nAlarm = objXML.SelectSingleNode("AlarmDictionary/Alarm[ID=1004]")
Debug.Print nAlarm.XML

End Sub

You can google for VBA XPath to find out how to access the various values.

Answer 3

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