通过VBA将XML加载到Excel中
我有一点VBA是通过VBA加载XML文件。 但是，当它被导入时，它全部在一列中，而不是分成一个表格。
当我通过数据选项卡手动导入时，我得到的警告没有模式，但询问我是否希望Excel基于源数据创build一个。 然后将所有的数据放在一个漂亮的表格中。
我希望在我目前的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>
谢谢，
::最终解决scheme::
Sub XMLfromPPTExample2() Dim XDoc As MSXML2.DOMDocument Dim xresult As MSXML2.IXMLDOMNode Dim xentry As MSXML2.IXMLDOMNode Dim xChild As MSXML2.IXMLDOMNode 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 Dim wb As Workbook Dim Col As Integer Dim Row As Integer Set XDoc = New MSXML2.DOMDocument XDoc.async = False XDoc.validateOnParse = False XDoc.Load ("http://api.trucast.net/2/saved_searches/0000/pivot/content_volume_trend/?apikey=00000&start=" + start_period + "&end=" + end_period + "&format=xml") LoadOption = xlXmlLoadImportToList Set xresult = XDoc.DocumentElement Set xentry = xresult.FirstChild Col = 1 Row = 1 For Each xentry In xresult.ChildNodes Row = 1 For Each xChild In xentry.ChildNodes Worksheets("Sheet2").Cells(Col, Row).Value = xChild.Text 'MsgBox xChild.BaseName & " " & xChild.Text Row = Row + 1 'Col = Col + 1 Next xChild 'Row = Row + 1 Col = Col + 1 Next xentry End Sub
“硬编码”的方式是这样的：
从这开始
<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>
你想获得两列的excel：
**published_date** | **post_count** 20130201 | 18 20120201 | 15
所以我们可以假设在你的XML中你将永远拥有
<result><entry><Element>VALUE</Element><Element...n>VALUE</Element...n></entry>
重要提示：在PowerPoint，Excel .. Word中打开VBA编辑器，并添加对“Microsoft XML，v3.0”的引用（此引用是针对Office 2000的…您可能有其他人）。
资料来源： http : //vba2vsto.blogspot.it/2008/12/reading-xml-from-vba.html
Employee.XML
<?xml version="1.0" encoding="UTF-8" standalone="yes"?> <EmpDetails> <Employee> <Name>ABC</Name> <Dept>IT-Software</Dept> <Location>New Delhi</Location> </Employee> <Employee> <Name>XYZ</Name> <Dept>IT-Software</Dept> <Location>Chennai</Location> </Employee> <Employee> <Name>IJK</Name> <Dept>HR Operations</Dept> <Location>Bangalore</Location> </Employee> </EmpDetails>
代码阅读上面的XML
Sub XMLfromPPTExample() Dim XDoc As MSXML2.DOMDocument Dim xEmpDetails As MSXML2.IXMLDOMNode Dim xEmployee As MSXML2.IXMLDOMNode Dim xChild As MSXML2.IXMLDOMNode Set XDoc = New MSXML2.DOMDocument XDoc.async = False XDoc.validateOnParse = False XDoc.Load ("C:\Emp.xml") Set xEmpDetails = XDoc.documentElement Set xEmployee = xEmpDetails.firstChild For Each xEmployee In xEmpDetails.childNodes For Each xChild In xEmployee.childNodes MsgBox xChild.baseName & " " & xChild.Text Next xChild Next xEmployee End Sub
在你的情况当然，你需要调整你的例程：
结果 – >提供的代码中的EmpDetails
进入 – >员工在提供的代码
加上其他必要的调整。
通过这种方式，您可以拥有多达“入门”和“入门儿童”的元素。
实际上，循环遍历“条目”中的所有元素，您将获得COLUMN，然后每个新条目都是新的行。
不幸的是，我没有在MAC上擅长，所以我只是把逻辑，你应该检查你自己的sintax …这样你在你想要的工作表上build立一个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：= xlXmlLoadImportToList？
您正在从URL调用中获取XML，但我强烈build议在开始时尝试使用磁盘上的XML文件，并检查它是否正确有效。 所以你应该做的是从这个“WebService”获取一个示例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
我使用了我find的其他代码段的几个部分。 下面的代码将提示用户select所需的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