excel - 读取 txt 文件的 VBA 代码，将指定的单词放入列中

Question

我正在尝试编写一个 VBA 宏，它将读取文本文档并将特定单词放入列中。更新:这是一个文件样本，显然是 XML，所以至少我今天学到了一些新东西。所以我想我需要一个程序来摆脱 XML 部分，并将文本放入列中。

<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>

最终，我试图将 4 位错误代码放入 A 列(即 1002、1004...)，并将错误消息放入 B 列(即刹车坏，无 Action ......)。我将粘贴到目前为止的内容，我尝试将其编码为仅开始一对数据。我一直试图将错误消息放入 B 列。错误消息都从每一行的相同位置开始，但我不知道如何停止复制文本，因为每个错误消息的长度不同人物。有任何想法吗？
(P.S. - 如果代码很糟糕，我很抱歉，我一直在实习电气工程师，所以我的编程已经相当生疏了。)

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

请尝试下一个代码:

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

它可以使用后期绑定(bind)工作，但最好有智能感知建议，尤其是在不太熟练使用 XML 的情况下。
如果添加这样的引用看起来很复杂，我可以添加一段代码来自动添加它。
请运行下一个代码以自动添加必要的引用。保存您的工作簿并在之后运行第一个代码:

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