11

I've got a bit of VBA that is loading an XML file through VBA. However when it is imported it is all in one column and not split into a table.

When I manually import this through the Data tab I get the warning there is no schema but asks if I would like Excel to create one based on source data. This then places all the data in a nice table.

I would like this to happen automatically within my current VBA code:

VBA looks like

      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

Currently the data then presents itself like this, unstructured. How can I automatically turn this into a table?

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

Thanks,

::Final solution::

 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 Answers 2

10

THE "HARD CODED" WAY IS THIS:

Starting from this

<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>

and you want to obtain an excel with two column:

**published_date** |  **post_count**
20130201       |           18
20120201       |           15

so that we can assume that in your XML you will always have

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

IMPORTANT: Open up VBA editor in PowerPoint, Excel.. Word and add references to "Microsoft XML, v3.0" (this reference is for Office 2000... you might have others).

Source: 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>

CODE TO READ ABOVE 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

In your case, of course, you need to adapt your routine:

result --> EmpDetails in the code provided
entry --> Employee in the code provided

plus any other necessary adjustment.


In this way you can have as much as many "entry" and "entry child" elements you want.

In fact, looping through all the elements inside your "entry" you will get your COLUMN, then every new entry is a new ROW.

Unfortunately, I don't have excel on the MAC so I just put the logic, you should check the sintax your own... in this way you build a EXCEL table on the worksheet you want.

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

THE CORRET WAY SHOULD BE THIS:

LoadOption:=xlXmlLoadImportToList?

You are getting the XML from a URL call, but I strongly suggest to try to work with an XML file on disk at the beginning, and check if it's correctly valid. So what you should do is get a sample XML from this "WebService" then save it on disk. An try load it in the following way:

   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
Sign up to request clarification or add additional context in comments.

15 Comments

Thanks @madthew so I have added in the rest of the code to the first post. The XML is being loaded through a REST URL so I don't have access to a workbook to amend. I have taken your suggested code and integrated it with mine (see bottom of first post) but this still doesn't load it into a tabular format. Have you any suggestions? Thanks, Sam
I know that the XML is loaded from a REST URL but if would be nice if you could at least save it as a file in order to test. Are you sure that the url reply with a valid XML file? Could you post the exact XML and what you want to obtain in the EXCEL? thanks
Thanks, you are right with what I want to achieve. I tried that code and it does work with loading from the URL but I can't get it to create a table. Mangling the code together stops the msgbox but it doesn't create a table, I can paste the code if it helps. I think I just need to know how to edit the code to replace msgbox with a table if that is easy enough?
I edited the answer... I can't do anything more than that. I'm sorry. I've dedicated a lot of time to that!
Thanks appreciate the help, still getting blanks for some reason, must be something to do with how the data is being loaded into Excel. I'll keep plugging away but your answer is a lot of help!
|
0

I used a few sections from other sections of code I've found. The below code will prompt the user to select the XML file you want and allows them to simply add/import the selected file into their existing mapping without opening a new file.

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

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.