vba 将xml导入到excel

'根据销售单从相应的xml文件中读取条形码数据，

'再输入到新建的excel文件中，改为特定的名字并保存。

Option Explicit

Sub FindNode()
Dim myWorkbook As Workbook
Dim ws As Worksheet
Dim rg As Range
Dim rgFirst As Range
Dim nLength As Integer
Dim strTmp As String
Dim strFilePath As String '第三方2文件夹中导入xml文件名
Dim strFileExl As String '导出文件2文件夹中导出exl文件名
Dim nNum As Integer  '销售件数
'nLength = 0
strTmp = ""
On Error GoTo errEx

Set rgFirst = Cells(ActiveCell.Row, ActiveCell.Column)

Do While rgFirst.Value <> ""  '*************循环**********************************

nLength = 0
strTmp = rgFirst.Value

If Right(strTmp, 1) > 9 Then
    MsgBox (strTmp & "的发货单据号有误！")
    Exit Sub
End If   '如果药检码单尾数是7位，以下将6改成7即可
strFilePath = ThisWorkbook.Path & "\第三方2\SalesWareHouseOut_" & Right(strTmp, 6) & ".xml"
strFileExl = ThisWorkbook.Path & "\导出文件2\" & Application.WorksheetFunction.Text(rgFirst.Offset(0, -1), "yyyymmdd") _
 & rgFirst.Offset(0, 2) & rgFirst
 nNum = rgFirst.Offset(0, 4)

Set myWorkbook = Workbooks.Add(xlWBATWorksheet)
Set myWorkbook = ActiveWorkbook
Set ws = myWorkbook.Worksheets(1)
Set rg = ws.Cells(1, 2)
rg.ColumnWidth = 22
rg.Offset(0, -1).ColumnWidth = 4
ws.Columns("B:B").NumberFormatLocal = "@"
rg = "电子监管码"

 Dim objDOM As Object
 Dim nodes As Object
 Dim n As Object
  '装载xml文档到dom 文档中
 Set objDOM = CreateObject("MSXML.DOMDocument")
  objDOM.Load (strFilePath)
  '查找并选择文档中的所有id节点
  Set nodes = objDOM.SelectNodes("//Data")
   '遍历节点并输出每个节点
  For Each n In nodes
    Set rg = rg.Offset(1, 0)
    nLength = nLength + 1
    rg = n.Attributes.Item(0).NodeValue
    rg.Offset(0, -1) = nLength
    'MsgBox n.Attributes.Item(0).NodeValue
    'MsgBox n.Text
  Next
  'nLength = n.Length
  If nLength <> nNum Then
    MsgBox (strTmp & "的件数不对！第三方2文件夹中的xml文件可能错误！")
    Exit Sub
  End If
  On Error Resume Next
  myWorkbook.SaveAs (strFileExl)
  myWorkbook.Close
  
  Set rgFirst = rgFirst.Offset(1, 0)
  
Loop          ' *************循环**********************************

  Exit Sub
errEx:
 MsgBox (strTmp & "的执行有错误，请检查！")
End Sub

Sub Macro1()
Application.OnKey "^+f", "FindNode"
End Sub