• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 414
  • Last Modified:

Importing XML into an Excel 97/2000 worksheet

Hi,

Hopefully a simple one.

Wonder if anyone can supply some VBA code that when run in Excel 97 will take XML from an HTTP URL source and store the entries in the worksheet cells.

eg.
<?xml version="1.0" encoding="UTF-8" ?>
<people total="3">
<person name="Bob" siblings="2">
<child name="Bill"></child>
<child name="Ben"></child>
</person>
<person name="Anne" siblings="1">
<child name="Charlie"></child>
</person>
<person name="Dave" siblings="3">
<child name="Eric"></child>
<child name="Fred"></child>
<child name="George"></child>
</person>
</people>


Ideally, the worksheet would be similar to,

Bob,Bill
Bob,Ben
Anne,Charlie
Dave,Eric
Dave,Fred
Dave,George


This may sound simple in principle but I'm not even sure it can be done.

No external software or 3rd party parsers can be installed except Office 97 (or possibly 2000 at a push) and the parser that comes with IE5+.

I've had a good dig around the MSDN site but can find anything other than all the XP stuff.


To someone who knows their stuff this should be 300 easy points :-)


TIA,

Alex

0
Alex_Gould
Asked:
Alex_Gould
  • 3
  • 2
1 Solution
 
bruintjeCommented:
Hi Alex_Gould, i think the samples from this page can help a lot

http://www.geocities.com/tomizono/tools/xml2xl.html

HTH:O)Bruintje
0
 
Alex_GouldAuthor Commented:
Hi,


Much appreciated.

The example on this site is almost ideal. It is a VB program, and I'm really after a VBA macro.

But this has given me the prompt I needed.

I really appreciate the fact that even though you didn't post any sample code, you didn't just copy of modify these and claim it as your own. That shows integrity !

I'm including the code in this comment so if anyone comes by after the same solution this then they will have the same code - just in case Mr. Tomizono site is removed.

It is released under GNU and so the aim is to help people afterall.

Many thanks again.

Alex

______________________________


Attribute VB_Name = "ConvXml2XL1"
Option Explicit

Dim xmlUrl As String, ErrMes As String

Sub okGo()
' main program
    xmlUrl = "C:\tmp\resume-1.xml"     ' URL of a target XML
    If Not convMain Then MsgBox ErrMes    ' execution
End Sub

'___________________________________________________________
'conv-xml2xl-1 version 1.1, Copyright (C) 2000 Tomizono <tomizono@yahoo.com>
'conv-xml2xl-1 comes with ABSOLUTELY NO WARRANTY. This is free software,
'and you are welcome to redistribute it under certain conditions.
'See http://www.gnu.org/copyleft/gpl.html#SEC3 for details.
'___________________________________________________________
'convert an xml document into an MS Excel Worksheet. (DOM Tree view)
'this is a VBA module source for MS Excel.
'input: well-formed XML document
'output: Microsoft Excel Book
'this version: http://www.geocities.com/tomizono/gpl/2000/conv-xml2xl-1.1.1.bas
'lattest: http://www.geocities.com/tomizono/gpl/conv-xml2xl-1.bas
'
'Further information is available at:
'http://www.geocities.com/tomizono/tools/xml2xl.html
'___________________________________________________________
'conv-xml2xl-1: convert an xml into an MS Excel book.
'Copyright (C) 2000 Tomizono <tomizono@yahoo.com>
'
'This program is free software; you can redistribute it and/or modify
'it under the terms of the GNU General Public License as published by
'the Free Software Foundation; either version 2 of the License, or
'(at your option) any later version.
'
'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'GNU General Public License for more details.
'
'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
'___________________________________________________________

Function LoadXML() As Object
    ' load specified XML, return the object
    Set LoadXML = CreateObject("MSXML.DOMDocument")
    LoadXML.async = False
    LoadXML.Load (xmlUrl)
End Function
   
Function CheckXML(xmlObj As Object) As Boolean
    ' validate XML
    Dim pErr As Object
    Set pErr = xmlObj.parseError
    If (pErr.errorCode <> 0) Then
        ErrMes = "Error: " & pErr.url & " cannot be parsed." & vbCrLf _
            & "Error reason: " & pErr.reason & vbCrLf _
            & "Error position: " & pErr.srctext & " (line " & pErr.Line & ")"
        CheckXML = False
    Else
        CheckXML = True
    End If
End Function

Function convMain() As Boolean
' convert to Excel
    Dim MySheet As Worksheet
    Dim xmlObj As Object
   
    ' before
    convMain = False
    Set xmlObj = LoadXML          ' load XML
    If Not CheckXML(xmlObj) Then  ' check XML
        Set xmlObj = Nothing
        Exit Function
    End If
    Set MySheet = MakeMyBook      ' create a new Book
    MySheet.Activate
    xml2xl1 xmlObj, MySheet.Range("A1")     ' DOM to Range
    ' after
    With MySheet.Cells
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
    End With
   
    Set xmlObj = Nothing
    Set MySheet = Nothing
    convMain = True
End Function

Function MakeMyBook() As Worksheet
' create a new Book, return a sheet object of the book
    Set MakeMyBook = Application.Workbooks.Add.Worksheets(1)
End Function

Function xml2xl1(iNode As Object, MyRange As Range) As Boolean
' read DOM and write to Range
    Dim iNode2 As Object
    Dim iAttr As Object
    Dim i As Long
    Const NODE_ELEMENT = 1
    Const NODE_DOCUMENT = 9
   
    If (iNode.nodeType = NODE_ELEMENT) Then
   
    ' Name and Text of myself (element)
        MyRange.Value = iNode.nodeName
        MyRange.Interior.ColorIndex = 40
        If iNode.selectNodes("text()").Length > 0 Then
            Set MyRange = MyRange.Offset(0, 1)
            MyRange.Value = iNode.selectSingleNode("text()").Text
            MyRange.Interior.ColorIndex = 19
            Set MyRange = MyRange.Offset(1, 0)
        Else
            Set MyRange = MyRange.Offset(1, 1)
        End If
    ' Attributes
        Set iAttr = iNode.Attributes
        For i = 0 To iAttr.Length - 1
            MyRange.Value = iAttr(i).Name
            MyRange.Interior.ColorIndex = 35
            Set MyRange = MyRange.Offset(0, 1)
            MyRange.Value = iAttr(i).Text
            MyRange.Interior.ColorIndex = 19
            Set MyRange = MyRange.Offset(1, -1)
        Next i
        Set iAttr = Nothing
   
    ElseIf (iNode.nodeType = NODE_DOCUMENT) Then
        MyRange.Value = xmlUrl
        Set MyRange = MyRange.Offset(1, 1)
    End If
   
    ' child Elements
    Set iNode2 = iNode.selectNodes("*")
    For i = 0 To iNode2.Length - 1
        xml2xl1 iNode2(i), MyRange
    Next i
    Set MyRange = MyRange.Offset(0, -1)
    Set iNode2 = Nothing
   
    xml2xl1 = True
End Function





0
 
bruintjeCommented:
why the C?
0
Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

 
Alex_GouldAuthor Commented:
Sorry, should have been a B.


My mistake.

Alex
0
 
MoondancerCommented:
Corrected per your request in Community Support.
Moondancer - EE Moderator
0
 
bruintjeCommented:
gosh, didn't even think to long about it, was only a first reaction ;)

But thanks anyway
0

Featured Post

Never miss a deadline with monday.com

The revolutionary project management tool is here!   Plan visually with a single glance and make sure your projects get done.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now