Загрузка XML в Excel через VBA
у меня есть немного VBA, который загружает XML-файл через VBA. Однако, когда он импортируется, все это находится в одном столбце и не разбивается на таблицу.
когда я вручную импортирую это через вкладку данных, я получаю предупреждение, что нет схемы, но спрашивает, хочу ли я, чтобы 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>
спасибо,
::окончательное решение::
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
2 ответов
"ЖЕСТКО ЗАКОДИРОВАННЫЙ" СПОСОБ ТАКОВ:
начиная от
<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>
важно: Откройте редактор VBA в PowerPoint, Excel.. Слово и добавить ссылки на " Microsoft XML, v3.0 "( Эта ссылка предназначена для Office 2000... возможно, другие).
источник:http://vba2vsto.blogspot.it/2008/12/reading-xml-from-vba.html
сотрудник.В 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 в предоставленном коде
запись --> сотрудник в предоставленном коде
плюс любые другие необходимые регулировка.
таким образом, вы можете иметь столько, сколько "запись" и "запись дочерних" элементов вы хотите.
на самом деле, петля через все элементы внутри вашей "записи" вы получите свой столбец, тогда каждая новая запись является новой строкой.
к сожалению, у меня нет 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
в CORRET WAY ДОЛЖЕН БЫТЬ ТАКИМ:
LoadOption:=xlXmlLoadImportToList?
вы получаете XML из вызова URL, но я настоятельно рекомендую попробовать работать с XML-файлом на диске в начале и проверить, правильно ли он действителен. Так что вы должны сделать, это получить образец 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