Как перейти к следующему доступному узлу XML в цикле Do While в VBA, если на одном узле отсутствует исходный файл XML - PullRequest
Новая
       6

Как перейти к следующему доступному узлу XML в цикле Do While в VBA, если на одном узле отсутствует исходный файл XML

0 голосов
/ 21 января 2019

В настоящее время я использую код Excel VBA для импорта определенных узлов из файла XML в электронную таблицу Excel.Файл XML представляет собой журнал, сгенерированный одним из устройств, которые я использую, и по некоторым причинам в некоторых журналах отсутствуют узлы.Ниже приведен пример полного XML и XML, в котором отсутствуют некоторые узлы.

Выдержка из полного XML-файла: 

-<data>
    <totaltime>992.1</totaltime>
    <totaldist>0.0</totaldist>
   -<avg seg="0">
      <priamp>259.5</priamp>
      <bkgamp>159.2</bkgamp>
      <pritrav>4.99</pritrav>
      <bkgtrav>4.98</bkgtrav>
      <privolt>10.7</privolt>
      <bkgvolt>8.8</bkgvolt>
      <priwire>27.5</priwire>
      <bkgwire>17.8</bkgwire>
      <time_act>992.1</time_act>
      <heat>25.1</heat>
    </avg>
 </data>

Выдержка из отсутствующего узла XML-файла, то есть <priwire> и <bkgwire>: 

-<data>
    <totaltime>992.1</totaltime>
    <totaldist>0.0</totaldist>
   -<avg seg="0">
      <priamp>259.5</priamp>
      <bkgamp>159.2</bkgamp>
      <pritrav>4.99</pritrav>
      <bkgtrav>4.98</bkgtrav>
      <privolt>10.7</privolt>
      <bkgvolt>8.8</bkgvolt>
      <time_act>992.1</time_act>
      <heat>25.1</heat>
    </avg>
 </data>

Ниже приведен мой VBA-код, который работает для того, что я делаю, однако, как только он находит один источник XML с отсутствующими узлами, маршрутизация останавливается и возвращает «Ошибка времени выполнения» 91: объектпеременная или переменная не установлена ​​". 

Private Sub Create_Heading()
    ' This subroutine creates the necessary headings in the specified cells.

    Range("A1").Value = "Bead No."
    Range("B1").Value = "Duration (s)"
    Range("C1").Value = "Log #"
    Range("D1").Value = "Sched. ID"
    Range("E1").Value = "System ID"

    Range("A1:E1").WrapText = True
    Range("A1:A2").Merge
    Range("B1:B2").Merge
    Range("C1:C2").Merge
    Range("D1:D2").Merge
    Range("E1:E2").Merge


    Range("F2").Value = "Peak Current"
    Range("G2").Value = "Back Current"
    Range("H2").Value = "Peak Voltage"
    Range("I2").Value = "Back Voltage"
    Range("J2").Value = "Peak Travel Speed"
    Range("K2").Value = "Back Travel Speed"
    Range("L2").Value = "Peak Wire Speed"
    Range("M2").Value = "Back Wire Speed"

    Range("F1:M1").Merge
    Range("F1").Value = "Set"

    Range("N2").Value = "Peak Current"
    Range("O2").Value = "Back Current"
    Range("P2").Value = "Peak Voltage"
    Range("Q2").Value = "Back Voltage"
    Range("R2").Value = "Peak Travel Speed"
    Range("S2").Value = "Back Travel Speed"
    Range("T2").Value = "Peak Wire Speed"
    Range("U2").Value = "Back Wire Speed"

    Range("N1:U1").Merge
    Range("N1").Value = "Actual"

    Range("V2").Value = "Date (DD/MM/YY)"
    Range("W2").Value = "Start (hh:mm:ss)"
    Range("X2").Value = "End (hh:mm:ss)"
    Range("Y2").Value = "Duration (hh:mm:ss)"
    Range("Z2").Value = "Waiting Time (hh:mm:ss)"

    Range("V1:Z1").Merge
    Range("V1").Value = "Timeline"


    Range("A1:Z2").HorizontalAlignment = xlCenter
    Range("A1:Z2").VerticalAlignment = xlCenter
    Range("A1:Z2").Font.Bold = True

    Range("A1").ColumnWidth = 5
    Range("B1:E1").ColumnWidth = 8
    Range("F1:U1").ColumnWidth = 9
    Range("V1:Z1").ColumnWidth = 14

    Range("F2:Z2").WrapText = True

    ActiveSheet.Columns("V").NumberFormat = "dd/mm/yy"
    ActiveSheet.Columns("W").NumberFormat = "hh:mm:ss"
    ActiveSheet.Columns("X").NumberFormat = "hh:mm:ss"
    ActiveSheet.Columns("Y").NumberFormat = "hh:mm:ss"
    ActiveSheet.Columns("Z").NumberFormat = "hh:mm:ss"

End Sub


Sub XMLProcessing_rev0()
    Dim StrFile As String
    Dim Address As String
    Dim i As Integer
    Set xmlDoc = CreateObject("MSXML2.DOMDocument")
    Application.StatusBar = "Initializing..."

    ' Check if heading area is empty, if so create headings.
    If WorksheetFunction.CountA(Range("A1:Z2")) = 0 Then
        Create_Heading
    End If

    ' Prompt user to enter the file location
    Address = InputBox("Enter folder location of data files:", "Welding Parameter XML Processing") & "\"
    ' Macro will look for files that satisfy the path: "UserAddress\LOG*"  i.e. LOG____.xml files
    StrFile = dir(Address & "LOG*")

    i = 0
    ' This loop runs for every file in the folder
    Do While Len(StrFile) > 0
        Application.StatusBar = "Copying row " & i + 1 & "."

        ' Load the XML document
        xmlDoc.Load (Address & StrFile)

        ' Set values in worksheet to data found in XML

        Cells(3 + i, 1).Value = xmlDoc.SelectSingleNode("//log").getAttribute("weld")
        Cells(3 + i, 2).Value = xmlDoc.SelectSingleNode("//data/totaltime").Text
        Cells(3 + i, 3).Value = xmlDoc.SelectSingleNode("//log").getAttribute("number")
        Cells(3 + i, 4).Value = xmlDoc.SelectSingleNode("//sched").getAttribute("id")
        Cells(3 + i, 5).Value = xmlDoc.SelectSingleNode("//log").getAttribute("sn")

        Cells(3 + i, 6).Value = xmlDoc.SelectSingleNode("//seg/priamp").Text
        Cells(3 + i, 7).Value = xmlDoc.SelectSingleNode("//seg/bkgamp").Text
        Cells(3 + i, 8).Value = xmlDoc.SelectSingleNode("//seg/privolt").Text
        Cells(3 + i, 9).Value = xmlDoc.SelectSingleNode("//seg/bkgvolt").Text
        Cells(3 + i, 10).Value = xmlDoc.SelectSingleNode("//seg/pritrav").Text
        Cells(3 + i, 11).Value = xmlDoc.SelectSingleNode("//seg/bkgtrav").Text
        Cells(3 + i, 12).Value = xmlDoc.SelectSingleNode("//seg/priwire").Text
        Cells(3 + i, 13).Value = xmlDoc.SelectSingleNode("//seg/bkgwire").Text

        Cells(3 + i, 14).Value = xmlDoc.SelectSingleNode("//data/avg/priamp").Text
        Cells(3 + i, 15).Value = xmlDoc.SelectSingleNode("//data/avg/bkgamp").Text
        Cells(3 + i, 16).Value = xmlDoc.SelectSingleNode("//data/avg/privolt").Text
        Cells(3 + i, 17).Value = xmlDoc.SelectSingleNode("//data/avg/bkgvolt").Text
        Cells(3 + i, 18).Value = xmlDoc.SelectSingleNode("//data/avg/pritrav").Text
        Cells(3 + i, 19).Value = xmlDoc.SelectSingleNode("//data/avg/bkgtrav").Text
        Cells(3 + i, 20).Value = xmlDoc.SelectSingleNode("//data/avg/priwire").Text
        Cells(3 + i, 21).Value = xmlDoc.SelectSingleNode("//data/avg/bkgwire").Text

        Cells(3 + i, 22).Value = xmlDoc.SelectSingleNode("//log/time/day").Text & "/" & xmlDoc.SelectSingleNode("//log/time/mo").Text & "/" & xmlDoc.SelectSingleNode("//log/time/yr").Text
        Cells(3 + i, 23).Value = xmlDoc.SelectSingleNode("//log/time/hr").Text & ":" & xmlDoc.SelectSingleNode("//log/time/min").Text & ":" & xmlDoc.SelectSingleNode("//log/time/sec").Text
        Cells(3 + i, 24).Value = Cells(3 + i, 23).Value + (Cells(3 + i, 2).Value / 86400)
        Cells(3 + i, 25).Value = Cells(3 + i, 24).Value - Cells(3 + i, 23).Value


        ' Center all cells in the row b/c formatting is nice
        Range(Cells(3 + i, 1), Cells(3 + i, 26)).HorizontalAlignment = xlCenter

        ' Don't remember what this is for, but it probably resets the StrFile _
        variable to what it was before the loop
        StrFile = dir
        i = i + 1
    Loop

    ' Reset status bar
    Application.StatusBar = False
End Sub

Я хотел бы изменить код таким образом, чтобы, если в XML-файле отсутствовал определенный узел, код оставлял соответствующую ячейку пустой и переходил кСледующая ячейка, а не возвращать сообщение об ошибке.

Буду признателен за любую помощь, которую вы мне сможете оказать.

...