读取 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 列（即刹车不良、无动作...）。我将粘贴到目前为止的内容，我尝试将其编码为仅开始一对数据。我一直试图将错误消息放入 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

它可以使用后期绑定，但最好有智能感知建议，尤其是在不太熟练使用 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

Answer 2

看起来您使用的 txt 文件实际上是一个 xml 文件。如果您更改了格式，我从here 稍微调整的这段代码应该可以正常工作。

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

如果您利用它是 XML 格式的事实，我认为您会发现这项任务会容易得多。您可以在 VBA here 中找到有关使用 XML 的更多信息。

Answer 3

正如 Ben Mega 所说：您有一个 XML 文件 - 为什么不使用 XML 功能。

将“Microsoft XML, v6.0”添加到您的项目引用中 - 然后您可以使用此代码

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

您可以搜索 VBA XPath 以了解如何访问各种值。