xml tag

P

pape93

New Member
Joined
Feb 1, 2011
Messages
14
Hi all,

I have the following code which i got from another forum to import data from an xml file, but I would like to take data from a specific tag.

PHP: 
Sub ImportData()

'Import file

    With ActiveSheet.QueryTables.Add(Connection:="FINDER;M:\1.xml", Destination _
        :=Range("$A$1"))
        .Name = "1_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

End Sub

This code imports all the data from the xml. I donot want all the data. I only want data from a specific tag. for example the code below:

PHP: 
<?xml version="1.0"?>
<Main>
    <Item>
        <Description>Printer</Description>
        <ProductID>HPj2300</ProductID>
        <Attached_document_code>BL09</Attached_document_code>
    </Item>
    <Item>
        <Description>Laptop</Description>
        <ProductID>HP2000</ProductID>
        <Attached_document_code>DC05</Attached_document_code>
    </Item>
    <Item>
        <Description>FlashDrive</Description>
        <ProductID>FD5521</ProductID>
        <Attached_document_code>CE05</Attached_document_code>
    </Item>
    <Item>
        <Description>Office Chair</Description>
        <ProductID>8898JHJ</ProductID>
        <Attached_document_code>IV05</Attached_document_code>
    </Item>
</Main>

I only want information from the tag <Description>. Is it possible to only take the data from this tag and can someone modify the code to show me how please.. thanks much
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
Hi,

I'm not super great with XML but you can use an XPath type of query to get the data and dump it into your worksheet. Note that for this scenario, we're not using a query table as such so you'll have to clean the old data out yourself (not too hard - something like what I've put in the ClearOldData sub below, but of course it must be edited to hit the right range in the workbook, as indeed is also the case with where to write in the new data).

<a href="http://northernocean.net/etc/mrexcel/20110621_XMLTest.zip">Test Workbook with XML File</a>
sha256 checksum (zip file): 5800af7107f67ff8c5976897d03a3a7480a4a147f1db7559a451e725e08d3b53

Code:
Code: 
[COLOR="Navy"]Public[/COLOR] [COLOR="Navy"]Sub[/COLOR] XMLFoo()

[COLOR="Navy"]Dim[/COLOR] doc [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'MSXML2.DOMDocument60[/COLOR]
[COLOR="Navy"]Dim[/COLOR] x [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'MSXML2.IXMLDOMSelection[/COLOR]
[COLOR="Navy"]Dim[/COLOR] a() [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

    [COLOR="Navy"]Dim[/COLOR] ws [COLOR="Navy"]As[/COLOR] Worksheet
    [COLOR="Navy"]Set[/COLOR] ws = ThisWorkbook.Worksheets("TestXML")
    
    [COLOR="Navy"]Set[/COLOR] doc = CreateDOM
    doc.Load ThisWorkbook.Path + "\Test.xml"
    [COLOR="Navy"]Set[/COLOR] x = doc.getElementsByTagName("Description")
    
    [COLOR="Navy"]If[/COLOR] x.Length > 0 [COLOR="Navy"]Then[/COLOR]
        [COLOR="SeaGreen"]'//Clear old data from worksheet before repopulating[/COLOR]
        [COLOR="Navy"]Call[/COLOR] ClearOldData(ws)
        [COLOR="SeaGreen"]'//Short pause[/COLOR]
        Application.Wait (Now + TimeValue("00:00:01"))
        [COLOR="SeaGreen"]'//Parse XML[/COLOR]
        [COLOR="Navy"]ReDim[/COLOR] a(0 [COLOR="Navy"]To[/COLOR] x.Length)
        [COLOR="Navy"]For[/COLOR] i = 0 [COLOR="Navy"]To[/COLOR] x.Length - 1
            a(i) = x.Item(i).Text
        [COLOR="Navy"]Next[/COLOR] i
        [COLOR="SeaGreen"]'//Write new data[/COLOR]
        ActiveSheet.Range("A2").Resize(UBound(a) + 1, 1).Value = WorksheetFunction.Transpose(a)
    [COLOR="Navy"]Else[/COLOR]
        MsgBox "No new data found."
    [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]

My_Exit:
[COLOR="Navy"]Set[/COLOR] doc = [COLOR="Navy"]Nothing[/COLOR]
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Sub[/COLOR]

ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
[COLOR="Navy"]Resume[/COLOR] My_Exit:

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Function[/COLOR] CreateDOM() [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR]
[COLOR="Navy"]Dim[/COLOR] dom
    
    [COLOR="Navy"]Set[/COLOR] dom = CreateObject("MSXML2.DOMDocument.6.0")
    dom.async = False
    dom.validateOnParse = False
    dom.resolveExternals = False
    [COLOR="Navy"]Set[/COLOR] CreateDOM = dom

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]

[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Function[/COLOR] ClearOldData(ByRef ws [COLOR="Navy"]As[/COLOR] Worksheet)
[COLOR="Navy"]Dim[/COLOR] LR [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
    
    LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
    ws.Range("A2:A" & LR).ClearContents

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]
 
Last edited:
Upvote 0
hi xenou,

Thank you so much. this code is working perfect after a few modifications.
I only have one small problem. It may be simple but i cant get around it.
If you look at the xml sample below you will notice i have multiple tags per Item with the name
<Attached_document_code>. I only want the first tag to appear in my data because the second and third are always empty. I need your help with this one.

PHP: 
<?xml version="1.0"?>
<Main>
    <Item>
        <Description>Printer</Description>
        <ProductID>HPj2300</ProductID>
        <Attached_document_code>BL09</Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
    </Item>
    <Item>
        <Description>Laptop</Description>
        <ProductID>HP2000</ProductID>
        <Attached_document_code>DC05</Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
    </Item>
    <Item>
        <Description>FlashDrive</Description>
        <ProductID>FD5521</ProductID>
        <Attached_document_code>CE05</Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
    </Item>
    <Item>
        <Description>Office Chair</Description>
        <ProductID>8898JHJ</ProductID>
        <Attached_document_code>IV05</Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
        <Attached_document_code>
            <null/>
        </Attached_document_code>
    </Item>
</Main>

Thank you so much for the help
I appreciate it.
 
Upvote 0
Hi,
What kind of output are you looking for? Do we want two columns (Description, first attached_document_code)? I'm guessing parsing the XML shouldn't be too hard (though actually I'm only just learning this stuff) - but I want to be sure what kind of result we are looking for in Excel.

ξ
 
Upvote 0
A few changes:
Code: 
Public Sub XMLFoo()

Dim doc As MSXML2.DOMDocument60
Dim x As MSXML2.IXMLDOMSelection
Dim a() As String
Dim i As Long

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("TestXML")
    
    Set doc = CreateDOM
    doc.Load ThisWorkbook.Path + "\Test.xml"
    Set x = doc.getElementsByTagName("Description")
    
    If x.Length > 0 Then
        '//Clear old data from worksheet before repopulating
        Call ClearOldData(ws)
        '//Short pause
        Application.Wait (Now + TimeValue("00:00:01"))
        '//Parse XML
[COLOR="Red"]        ReDim a(0 To x.Length, 0 To 1)[/COLOR]
        For i = 0 To x.Length - 1
[COLOR="Red"]            a(i, 0) = x.Item(i).Text[/COLOR]
[COLOR="Red"]            a(i, 1) = x.Item(i).nextSibling.nextSibling.Text[/COLOR]
        Next i
        '//Write new data
[COLOR="Red"]        ActiveSheet.Range("A2").Resize(UBound(a) + 1, 2).Value = a[/COLOR]
    Else
        MsgBox "No new data found."
    End If

My_Exit:
Set doc = Nothing
Exit Sub

ErrHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume My_Exit:

End Sub

And:
Code: 
Private Function ClearOldData(ByRef ws As Worksheet)
Dim LR As Long
    
    LR = ws.Cells(Rows.Count, 1).End(xlUp).Row
    [COLOR="Red"]ws.Range("A2:B" & LR).ClearContents[/COLOR]

End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Is it possible to build a macro to import similar, but different xml/text files?
Replies
0
Views
929
alparsons672
A
Imposter
  • Question Question
VBA to import XML files from multiple subfolders of a folder and save imported data to XLSM files by folder
2
Replies
15
Views
6K
Imposter
Imposter
J
  • Question Question
Import XML as text on Mac version
2
Replies
10
Views
2K
jlduerr
J
A
  • Question Question
Import CSV data
Replies
4
Views
721
sandy666
sandy666
A
  • Question Question
Challenge To Scrape A Page With VBA
Replies
1
Views
4K
Rijnsent
Rijnsent

Forum statistics

Threads
1,224,548
Messages
6,179,451
Members
452,915
Latest member
hannnahheileen

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top