Excel Macro via VBA - XML IMPORT

[Virgil]

I wonder if someone can help me with what i need code wise in the ' HELP here
please
below.

I want to update EXISTING records from an xml source using the XML data.
Details are in the sample code below.

Many thanks in advance

Sub Read_XML_Data()
Dim rst As ADODB.Recordset
Dim stCon As String, stFile As String
Dim i As Long, j As Long

' This has row records which have the rows "NAME" in Column A
' then updates to other colums within the row
' NB: Only some of the row columns will be updated.
stFile = "C:\myupdates.xml"
stCon = "Provider=MSPersist;"

With rst
.CursorLocation = adUseClient
.Open stFile, stCon, adOpenStatic, adLockReadOnly, adCmdFile
Set .ActiveConnection = Nothing
End With

With ActiveSheet
' HELP here please
' Find the row with the same "NAME" as what is in the XML record
' code here
'Copy the data from the XML recordset for this "NAME" into the row
'.Range("... rst....
End With
'Closing the recordset.
rst.Close

'Release object from memory.
Set rst = Nothing

End Sub

XML
<row>
<name>fred</name>
<age>24</age>
<email>[email protected]</email>
</row>
....

 

[Joel]

Can you provide a more complete XML file. the cod eyou provided isn't
opening up the xml file properly. I can get the data into excel if I can get
the recordset opened properly. I keep on getting an error that the XML file
is incomplete.

 

[Virgil]

I come clean, i borrowed the XML part from a web sample. I assumed it worked.
here is say 2 rows in xml and i have corrected a syntax error...

<?xml version="1.0" ?>
<row>
<people>
<name>fred</name>
<age>24</age>
<email>[email protected]</email>
</people>
<people>
<name>mary</name>
<age>24</age>
<email>[email protected]</email>
</people>
</row>

Thanks for the interest

 

[Joel]

I still cna't get the RST to open. I had to add new into the following
declaration

Dim rst As New ADODB.Recordset

Once I get the recordset to open I can easily get the rest of the code to
work.

 

[Virgil]

Thanks for a reply. However my original issue is unresolved ?
How to lock the row and update it ?


Can you help ?

Thanks

 

[Joel]

You can open the XML file in a new worksheet and then extract the information
you are looking for. Right now I can't get the xlm file opened using your
methods. If yo uhave a webpage where you obtained you method post it so I
can help you solve this problem.

 

[Virgil]

OK i re-did the approach

Sub Read_XML()
Dim xmlDom As MSXML2.DOMDocument
Dim i As Long, j As Long
' Add a reference to Microsoft XML, v6.0
Set xmlDom = New MSXML2.DOMDocument
xmlDom.Load "C:\temp\sample.xml"

For i = 0 To xmlDom.DocumentElement.ChildNodes.Length - 1

Debug.Print "Name Pairs to be printed"
For j = 0 To xmlDom.DocumentElement.ChildNodes.Item(i).ChildNodes.Length
- 1
' Print the name of the column and then the value for the column
Debug.Print
xmlDom.DocumentElement.ChildNodes.Item(i).ChildNodes.Item(j).nodeName, " = ",
xmlDom.DocumentElement.ChildNodes.Item(i).ChildNodes.Item(j).nodeTypedValue
Next j

Next i

Set xmlDom = Nothing
End Sub

on the sample provided printed to the immediate window

=============================
Name Pairs to be printed
name = fred
age = 24
email = (e-mail address removed)
Name Pairs to be printed
name = mary
age = 24
email = (e-mail address removed)
=====================

So now hopefully i can get help on how to set the excel row with the NAME
and update the fields.

Thanks

 

[Joel]

I cleanup you code to make it easier to understand. I used "For Each"
instead of "For 1 to .....". I put the XML data into a Table instead of down
Rows like you did.

I made the code very versitile so it will work with more columns than your
example since I didn't know how big your database is. I made the code tow
loops, one to create the table and then a second one to move the data into
your original worksheet. I assumed the xml table to go into Sheet 2 and the
table you were updating in sheet 1.

Not know how many column you were importing in the XML and the order of the
coloumns I used a lookup (using VBA FIND) to find the actual columns. I then
lookup the name in column A on Sheet 1 and put the age and email into columns
B and C respectively.

Your original code I didn't know which methods you wanted to use to import
the XML and since you had code I let you get that part working. I think you
will like what I did below.


Sub Read_XML()
Dim xmlDom As MSXML2.DOMDocument
Dim i As Long, j As Long
' Add a reference to Microsoft XML, v6.0
Set xmlDom = New MSXML2.DOMDocument
xmlDom.Load "C:\temp\sample.xml"

With Sheets("Sheet2")
RowCount = 1
For Each xmlrow In xmlDom.DocumentElement.childNodes
ColCount = 1

For Each xmlCol In xmlrow.childNodes
If RowCount = 1 Then
'print tagname = row 1 and data in row 2
.Cells(1, ColCount) = xmlCol.tagname
.Cells(2, ColCount) = xmlCol.Text
Else
.Cells(RowCount, ColCount) = xmlCol.Text
End If
ColCount = ColCount + 1
Next xmlCol

If RowCount = 1 Then
RowCount = 3
Else
RowCount = RowCount + 1
End If
Next xmlrow

Set xmlDom = Nothing

'get Name column by searching header row
Set NameHeader = .Rows(1).Find(what:="Name", _
LookIn:=xlValues, lookat:=xlWhole)
If NameHeader Is Nothing Then
MsgBox ("Error : Cannot find Name in header row")
Exit Sub
Else
NameCol = NameHeader.Column
End If

'get age column by searching header row
Set AgeHeader = .Rows(1).Find(what:="age", _
LookIn:=xlValues, lookat:=xlWhole)
If AgeHeader Is Nothing Then
MsgBox ("Error : Cannot find Age in header row")
Exit Sub
Else
AgeCol = AgeHeader.Column
End If

'get email column by searching header row
Set EmailHeader = .Rows(1).Find(what:="email", _
LookIn:=xlValues, lookat:=xlWhole)
If EmailHeader Is Nothing Then
MsgBox ("Error : Cannot find Email in header row")
Exit Sub
Else
EmailCol = EmailHeader.Column
End If


LastRow = .Cells(Rows.Count, NameCol).End(xlUp).Row
For RowCount = 2 To LastRow
Name = .Cells(RowCount, NameCol)
Age = .Cells(RowCount, AgeCol)
Email = .Cells(RowCount, EmailCol)


With Sheets("Sheet1")
'lookup name
Set c = .Columns(NameCol).Find(what:=Name, _
LookIn:=xlValues, lookat:=xlWhole)

If c Is Nothing Then
MsgBox ("Cannot find : " & Name)
Else
'put updated data into sheet 1
.Range("B" & c.Row) = Age
.Range("C" & c.Row) = Email
End If
End With


Next RowCount


End With
End Sub

 

[Virgil]

Thanks Joel, the foreach is much cleaner and easier to understand and the
row handling now makes sense for me.

Yes each row has more than 20 colums and only some of these will be
referenced in the XML

Thanks again.

 

[Joel]

What I'm not sure of if each row will have the same columns in the same
order. the tagnames are really the column headers You may need to
re-arrange the code to use the tagname to find the correct column when
reading the XML. Let me know if you need more help.

 

[Virgil]

Thanks Joel

My understanding of the examples for VBA, there is no free dictionary format
that you get in C# where you can use Col("fieldname"). All the references
seem to be numeric. So a simple indexing function would be needed to gain
this functionality,
e.g.
Col(GetIndex(Col, "age"))

Thanks

 

[Joel]

There is a back door in getting the column names but I don't think you want
to go that way. All office products files (doc,xls,dbm,ppt) have the same
file structure. You can open any of the office applications with any VBA in
the products. All files are composed of blocks of data that ware eiter a
document, table, picture. It turns out there is very little difference
between an Access table and an Excel worksheet except th eapplication that
runs the data. The file structure is exactly the same. Access is better
designed to work with large files and shared files than excel. Excel is
better at randomly access any cell (Access has to move down one row at a
time, and then one column at a time).

In Access you can call the columns by the header row name. So if you open
your worksheet under an Access application you can get the columns similar to
the way you would get them in C#.

 

[Virgil]

The final for others is below and works a treat.

HOWEVER i have been driven crazy by Excel or the VBA IDE DELETING lines on
me...

Base file is a DBF file and macro lives in an XLS file.

Every time i would restart the
Set xmlDom = New MSXML2.DOMDocument
line was removed. I went to modify a MsgBox and several of the MsgBox's
where deleted.
Other code lines were randomly deleted between runs.

I am using Excel 2007 and perhaps this has issues ... as i used to use Excel
2003.

Cheers

=================

'
' This function will read an XML file which has DBF updates and
' update the records in the current Sheet with this data.
' This was designed for Trends but could be used for other DBFs
' The column name to identify the row is coded to be "NAME"
'
Sub Excel_Row_Updates()
Dim RowCount As Long, ColCount As Long, RowUpdateCount As Long
' Add a reference to Microsoft XML, v6.0
Dim xmlFile As Variant
Dim xmlrow As Variant
Dim xmlcol As Variant
Dim NameHeader As Variant
Dim NameCol As Variant
Dim LastRow As Variant
Dim c As Variant
Dim NameXmlCol As Long
Dim NameDbfRow As Long
Dim NameDbfCol As Long
Dim FieldUpdates As Long
Dim xmlDom As MSXML2.DOMDocument
Set xmlDom = New MSXML2.DOMDocument

FieldUpdates = 0
RowCount = 0
RowUpdateCount = 0

xmlFile = Application.GetOpenFilename("Select XML file (*.xml), *.xml")

If xmlFile <> False Then

xmlDom.load (xmlFile)

' We assume that the macro is run from the main Excel page
With ActiveSheet

Debug.Print ActiveSheet.Name
' Find the column name is in
Set NameHeader = .Rows(1).Find(what:="NAME", _
LookIn:=xlValues, lookat:=xlWhole)
If NameHeader Is Nothing Then
MsgBox ("Error : Cannot find NAME in header row")
Set xmlDom = Nothing
Exit Sub
Else
NameCol = NameHeader.Column
End If

For Each xmlrow In xmlDom.documentElement.childNodes

RowCount = RowCount + 1

' Find the NAME value for each XML record set
For Each xmlcol In xmlrow.childNodes
If xmlcol.tagName = "NAME" Then
Exit For
End If
Next xmlcol

' Find the row that the NAME is in in the DBF / EXCEL

NameDbfRow = 0

Set c = .Columns(NameCol).Find(what:=xmlcol.Text, _
LookIn:=xlValues, lookat:=xlWhole)

If c Is Nothing Then
GoTo Continue ' Row does not exist, consider not fatal as
sheet maybe a subset
Else
' We know the row the "NAME" item value is in
NameDbfRow = c.Row
RowUpdateCount = RowUpdateCount + 1
End If

' OK we have found the row the data is in so lets update the
other columns
For Each xmlcol In xmlrow.childNodes
If xmlcol.tagName <> "NAME" Then
' Update the DBF row with the value for this name
Set c = .Rows(1).Find(what:=xmlcol.tagName, _
LookIn:=xlValues, lookat:=xlWhole)

If c Is Nothing Then
' Although the row does not have to exist, if the row
does exist then
' the columns must exist.
MsgBox (xmlcol.tagName & " does not exist in the DBF
file.")
GoTo Abort
Else
'Field column found in DBF record
NameDbfCol = c.Column
If NameDbfRow > 1 Then ' Security check, has to be

1

.Cells(NameDbfRow, NameDbfCol) = xmlcol.Text
FieldUpdates = FieldUpdates + 1
End If
End If
End If
Next xmlcol

Continue:
Next xmlrow

End With

MsgBox (RowUpdateCount & " rows updated from " & RowCount & " records,
please save file.")

Abort:
Set xmlDom = Nothing

Else

MsgBox ("Aborting macro as no XML file was slected")

End If

End Sub

 

[Joel]

Try commenting out the line Set xmlDom = Nothing and see if the problem still
exist. I would think a firewall or a virsus protection software package
would behave like this and not a software package like excel/vba. I suspect
that setting an object to nothing may have potential problems and is a more
likely cause. If it does solve the problem I would notify microsoft because
this is a problem that definiely need to be fixed.