通过VBA将XML加载到Excel中

我有一点VBA，它通过VBA加载XML文件。但是，当导入时，它全部位于一列中，而不是拆分为一个表

当我通过“数据”选项卡手动导入此内容时，会收到警告“没有架构”，但会询问是否希望Excel基于源数据创建一个架构。然后将所有数据放在一个漂亮的表中

我希望在我当前的VBA代码中自动执行此操作：

VBA看起来像

      Sub refresh()

'--------------------------------1. Profile IDs-----------------------------------'


'date variables

Dim start_period As String
start_period = Sheets("Automated").Cells(1, 6).Value
Dim end_period As String
end_period = Sheets("Automated").Cells(1, 7).Value

'report id variable names
Dim BusinessplanningReportID As String

'--------------------------------REST queries--------------------------------'
Dim Businessplanning As String



'REST query values
Businessplanning = "URL;http://api.trucast.net/2/saved_searches/00000/pivot/content_volume_trend/?apikey=0000000&start=" + start_period + "&end=" + end_period + "&format=xml"




'--------------------------------------------Data connections-----------------------------------'
'key metrics
With Worksheets("Sheet1").QueryTables.Add(Connection:=Businessplanning, Destination:=Worksheets("Sheet1").Range("A1"))

  .RefreshStyle = xlOverwriteCells
  .SaveData = True

End With

目前，数据是这样呈现的，非结构化的。我怎样才能自动把它变成一张桌子

<result>
<entry>
<published_date>20130201</published_date>
<post_count>18</post_count>
</entry>

硬编码方式如下：

从这个开始,

<result>
   <entry>
      <published_date>20130201</published_date>
      <post_count>18</post_count>    
   </entry>
  <entry>
      <published_date>20120201</published_date>
      <post_count>15</post_count>    
   </entry>

因此，我们可以假设，在XML中，您将始终

<result><entry><Element>VALUE</Element><Element...n>VALUE</Element...n></entry>

当然，在您的情况下，您需要调整您的常规：

结果-->提供的代码中的详细信息
在提供的代码中输入-->Employee

加上任何其他必要的调整

---

通过这种方式，您可以拥有所需的任意多个“entry”和“entry-child”元素

Dim col = 1; Dim row=1;

For Each xEmployee In xEmpDetails.childNodes
    col = 1
    For Each xChild In xEmployee.childNodes
       Worksheets("NAMEOFTHESHEET").Cells(col, row).Value = xChild.Text
       MsgBox xChild.baseName & " " & xChild.Text
       col = col + 1;
    Next xChild
row = row+1;
Next xEmployee

事实上，通过循环遍历“条目”中的所有元素，您将得到您的列，然后每个新条目都是一个新行

不幸的是，我没有excel在MAC上，所以我只是把逻辑，你应该检查你自己的sintax。。。通过这种方式，您可以在所需的工作表上构建EXCEL表

Dim col = 1; Dim row=1;

For Each xEmployee In xEmpDetails.childNodes
    col = 1
    For Each xChild In xEmployee.childNodes
       Worksheets("NAMEOFTHESHEET").Cells(col, row).Value = xChild.Text
       MsgBox xChild.baseName & " " & xChild.Text
       col = col + 1;
    Next xChild
row = row+1;
Next xEmployee

正确的方法应该是：

LoadOption:=XLXmlLoadImportList

您是从URL调用获取XML的，但我强烈建议您在开始时尝试使用磁盘上的XML文件，并检查它是否正确有效。所以，您应该做的是从这个“Web服务”获取一个示例XML，然后将其保存在磁盘上。请尝试按以下方式加载它：

   Sub ImportXMLtoList()
    Dim strTargetFile As String
    Dim wb as Workbook

         Application.Screenupdating = False
         Application.DisplayAlerts = False
         strTargetFile = "C:\example.xml"
         Set wb = Workbooks.OpenXML(Filename:=strTargetFile,        LoadOption:=xlXmlLoadImportToList)
         Application.DisplayAlerts = True

         wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Sheet2").Range("A1")
         wb.Close False
         Application.Screenupdating = True
    End Sub

---

我使用了我找到的代码的其他部分中的一些部分。下面的代码将提示用户选择所需的XML文件，并允许用户只需将所选文件添加/导入到现有映射中，而无需打开新文件

Sub Import_XML()
'
' Import_XML Macro
'
    'Select the file
    Fname = Application.GetOpenFilename(FileFilter:="xml files (*.xml), *.xml", MultiSelect:=False)

    'Check if file selected
    If Fname = False Then
        Exit Sub
        Else

    End If

    'Import selected XML file into existing, custom mapping

    Range("B5").Select
    ActiveWorkbook.XmlMaps("Result_file_Map").Import URL:=Fname
End Sub

---

谢谢@madthew，所以我在第一篇文章中添加了剩余的代码。XML正在通过REST URL加载，因此我无法访问工作簿进行修改。我已经使用了您建议的代码，并将其与我的代码集成在一起（见第一篇文章的底部），但仍然没有将其加载到表格格式中。你有什么建议吗？谢谢，SamI知道XML是从RESTURL加载的，但是如果您至少可以将其保存为文件以进行测试，那就太好了。您确定url回复时包含有效的XML文件吗？您能在EXCEL中发布准确的XML和您想要获得的内容吗？谢谢汉克斯，你说得对，我想要实现的目标。我尝试了这段代码，它确实可以从URL加载，但我无法让它创建一个表。将代码混合在一起会停止msgbox，但它不会创建表，如果有帮助，我可以粘贴代码。我想我只需要知道如何编辑代码，用一个表替换msgbox，如果这足够简单的话？我编辑了答案。。。我不能做更多的事了。我很抱歉。我为此花了很多时间！感谢感谢您的帮助，由于某些原因仍然会出现空白，这一定与数据如何加载到Excel有关。我会继续努力的，但你的回答很有帮助！

Dim col = 1; Dim row=1;

For Each xEmployee In xEmpDetails.childNodes
    col = 1
    For Each xChild In xEmployee.childNodes
       Worksheets("NAMEOFTHESHEET").Cells(col, row).Value = xChild.Text
       MsgBox xChild.baseName & " " & xChild.Text
       col = col + 1;
    Next xChild
row = row+1;
Next xEmployee

   Sub ImportXMLtoList()
    Dim strTargetFile As String
    Dim wb as Workbook

         Application.Screenupdating = False
         Application.DisplayAlerts = False
         strTargetFile = "C:\example.xml"
         Set wb = Workbooks.OpenXML(Filename:=strTargetFile,        LoadOption:=xlXmlLoadImportToList)
         Application.DisplayAlerts = True

         wb.Sheets(1).UsedRange.Copy ThisWorkbook.Sheets("Sheet2").Range("A1")
         wb.Close False
         Application.Screenupdating = True
    End Sub

Sub Import_XML()
'
' Import_XML Macro
'
    'Select the file
    Fname = Application.GetOpenFilename(FileFilter:="xml files (*.xml), *.xml", MultiSelect:=False)

    'Check if file selected
    If Fname = False Then
        Exit Sub
        Else

    End If

    'Import selected XML file into existing, custom mapping

    Range("B5").Select
    ActiveWorkbook.XmlMaps("Result_file_Map").Import URL:=Fname
End Sub