Solved

Need XML code sample

Posted on 2001-08-22
13
368 Views
Last Modified: 2013-11-23
From my table (myTable), I need to export all of records into a XML document (i.e. "C:\XML\Customer.XML").

MyTable has 3 fields:
1/ ID
2/ Name
3/ Address

Thanks in advance
nguyenn
0
Comment
Question by:nguyenn
  • 5
  • 3
  • 2
  • +3
13 Comments
 
LVL 6

Expert Comment

by:JonFish85
Comment Utility
try something like this:

Go to project -> references, and make sure "Microsoft ActiveX Data Object 2.0" is checked. Now try this:

Private Sub Command1_Click()
Dim cn as adodb.connection
Dim rs as adodb.recordset

set cn = new adodb.connection
set rs = new adodb.recordset

  cn.open "YourConnectionString"
  set rs.ActiveConnection = cn
  rs.open "SELECT * FROM MyTable"
'Save to XML file
  rs.Save "C:\XML\Customer.XML", adPersistXML
End Sub

if you are already connected to your database, skip the first few lines, and just use the Save line. Im not sure my code is 100% accurate as I havent used ADO recently... Hope it helps!
0
 
LVL 1

Author Comment

by:nguyenn
Comment Utility
Hi JohnFish,

Sorry I would describe more detail:

XML document need to display in a format has some tags I want, then I could retrieve data from this XML dodument later:
ie.

<Cusomer List>
   <CustomerID>
   <CustomerName>
   <CustomerAddress>
</Customer List>
0
 
LVL 6

Expert Comment

by:JonFish85
Comment Utility
using the recordset to save to an XML file, it saves in the XML format, using the name of the fields...

<nameoftable>
  <Field1>value</Field1>
  <Field2>value</Field2>
  <FieldN>value</FieldN>
</nameoftable>

i believe that that is the format... let me know if Im still missing the point!
0
 
LVL 1

Author Comment

by:nguyenn
Comment Utility
Could you explain more detail? Do you mean the code like:

Dim str as string
str = "<nameoftable>"
....

Anyway, the tag name and the field names are different
is. ID vs CustomerID
    Name vs CustomerName
    Address vs CustomerAddress

thanks
nguyenn
0
 
LVL 14

Expert Comment

by:wsh2
Comment Utility
With a text editor, take a look at the XML code generated after running this program:

---------------------------------------------------------

1. Start a New Standard.Exe Project.
2. Add a DataGrid (DataGrid1) to Form1.
3. Set a reference (VB Menu -> Project -> References) to "Microsoft ActiveX Data Objects 2.1 Library"
4. Copy/Paste the following into the Form1 code window.
5. Change strFilePath to a temporary testing file path / name.
6. Change strFileXML to a temporary testing file path / name.
7. Press F5 to run. The datagrid will be filled with the test data and the test data will be saved as an XML file to strFileXML.

<----- Code Begin ----->

Option Explicit

Private Type typMailing
   sName As String * 25
   sAddress As String * 25
   sCity As String * 25
End Type

Private Type typMailingList
   uMailItems() As typMailing
End Type

Private m_cn As ADODB.Connection
Private m_udtMailingList As typMailingList

Private Sub Form_Load()
 
   Dim strFilePath As String
   strFilePath = "c:\tempwork\test.dat"   ' <-- CHANGE ME
   strFileXML = "c:\tempwork\test.XML"   ' <-- CHANGE ME
   
'  Create Test Data
   Call x_Build_Test_Data(strFilePath)
   
'  Read Test Data
   Dim intFreeFile As Integer: intFreeFile = FreeFile
   Open strFilePath For Binary As intFreeFile
   Get intFreeFile, , m_udtMailingList
   Close intFreeFile
   
'  Create Recordset
   Dim m_rs As New ADODB.Recordset
   With m_rs
      .Fields.Append "Name", adVariant, , adFldMayBeNull
      .Fields.Append "Address", adVariant, , adFldMayBeNull
      .Fields.Append "City", adVariant, , adFldMayBeNull
      .Open
   End With
   
'  Load Recordset
   Dim lngindex As Long
   For lngindex = LBound(m_udtMailingList.uMailItems) To UBound(m_udtMailingList.uMailItems)
      m_rs.AddNew
      With m_udtMailingList.uMailItems(lngindex)
         m_rs.Fields(0) = .sName
         m_rs.Fields(1) = .sAddress
         m_rs.Fields(2) = .sCity
      End With
      m_rs.Update
   Next lngindex
   
'  Assign To Datagrid
   Set DataGrid1.DataSource = m_rs
   
'  Persist The Data (ie.. save it to disk as an XML file)
   m_rs.Save strFileXML, adPersistXML

End Sub

Private Sub x_Build_Test_Data(ByVal i_strFilePath As String)

   If Dir(i_strFilePath) <> "" Then Kill i_strFilePath
   
   With m_udtMailingList
      ReDim .uMailItems(3)
   End With
   
   With m_udtMailingList.uMailItems(0)
      .sName = "Name 000"
      .sAddress = "Address 000"
      .sCity = "City 000"
   End With
   With m_udtMailingList.uMailItems(1)
      .sName = "Name 111"
      .sAddress = "Address 111"
      .sCity = "City 111"
   End With
   With m_udtMailingList.uMailItems(2)
      .sName = "Name 222"
      .sAddress = "Address 222"
      .sCity = "City 222"
   End With
         
   Dim intFreeFile As Integer: intFreeFile = FreeFile
   Open i_strFilePath For Binary As #1
   Put intFreeFile, , m_udtMailingList
   Close intFreeFile
   
End Sub

<----- Code End ----->
0
 
LVL 1

Author Comment

by:nguyenn
Comment Utility
Thanks WSH,

But I want the output of XML document should have the format similar:

i.e

<Cusomer List>
  <CustomerID>Id</CustomerID>
  <CustomerName>Name</CustomerName>
  <CustomerAddress>Address</CustomerAddress>
</Customer List>

0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 2

Expert Comment

by:mflam
Comment Utility
take a look at http://www.w3schools.com/xml
You get a quick tutorial of DOM,
including appending and creating an XML document.

Real easy and fast.
Just download the MS-XML3 (or is it 4 already?).
Add it to your references and start coding away.

Another good source is http://www.vbxml.com

Good Luck, Moshe
0
 
LVL 14

Expert Comment

by:wsh2
Comment Utility
This formats the data the way you like (I think).. <smile>.

'1. Start a New Standard.Exe Project.
'2. Add a DataGrid (DataGrid1) to Form1.
'3. Set a reference (VB Menu -> Project -> References) to "Microsoft ActiveX Data Objects 2.1 Library"
'4. Copy/Paste the following into the Form1 code window.
'5. Change strFilePath to a temporary testing file path / name.
'6. Change strFileXML to a temporary testing file path / name.
'7. Press F5 to run. The datagrid will be filled with the test data and the test data will be saved as an XML file to strFileXML.

'<----- Code Begin ----->

Option Explicit

Private Type typMailing
   sName As String * 25
   sAddress As String * 25
   sCity As String * 25
End Type

Private Type typMailingList
   uMailItems() As typMailing
End Type

Private m_cn As ADODB.Connection
Private m_udtMailingList As typMailingList


Private Sub Form_Load()
 
   Dim strFilePath As String
   strFilePath = "c:\tempwork\test.dat"   ' <-- CHANGE ME
   Dim strFileXML As String
   strFileXML = "c:\tempwork\test.XML"   ' <-- CHANGE ME
   
'  Create Test Data
   Call x_Build_Test_Data(strFilePath)
   
'  Read Test Data
   Dim intFreeFile As Integer: intFreeFile = FreeFile
   Open strFilePath For Binary As intFreeFile
   Get intFreeFile, , m_udtMailingList
   Close intFreeFile
   
'  Create Recordset
   Dim m_rs As New ADODB.Recordset
   With m_rs
      .Fields.Append "Name", adVariant, , adFldMayBeNull
      .Fields.Append "Address", adVariant, , adFldMayBeNull
      .Fields.Append "City", adVariant, , adFldMayBeNull
      .Open
   End With
   
'  Load Recordset With Test Data
   Dim lngIndex As Long
   For lngIndex = LBound(m_udtMailingList.uMailItems) To UBound(m_udtMailingList.uMailItems)
      m_rs.AddNew
      With m_udtMailingList.uMailItems(lngIndex)
         m_rs.Fields(0) = Trim(.sName)
         m_rs.Fields(1) = Trim(.sAddress)
         m_rs.Fields(2) = Trim(.sCity)
      End With
      m_rs.Update
   Next lngIndex
   
'  Display RecordSet
   Set DataGrid1.DataSource = m_rs
   
'  Persist The Data (ie.. save it to disk as an XML file) To Disk

   Dim strBuffer As String
   
   If Dir(strFileXML) <> "" Then Kill strFileXML
   Open strFileXML For Binary As intFreeFile
   With m_rs
      strBuffer = "<MyTable List>" & vbCrLf
      Put intFreeFile, , strBuffer
      .MoveFirst
      Do Until .EOF
         For lngIndex = 0 To m_rs.Fields.Count - 1
            strBuffer = "<" & .Fields(lngIndex).Name & ">" _
               & .Fields(lngIndex).Value _
               & "<\" & .Fields(lngIndex).Name & ">" _
               & vbCrLf
            Put intFreeFile, , strBuffer
         Next lngIndex
         .MoveNext
      Loop
      strBuffer = "<\MyTable List>" & vbCrLf
      Put intFreeFile, , strBuffer
   End With

End Sub

Private Sub x_Build_Test_Data(ByVal i_strFilePath As String)

   If Dir(i_strFilePath) <> "" Then Kill i_strFilePath
   
   With m_udtMailingList
      ReDim .uMailItems(3)
   End With
   
   With m_udtMailingList.uMailItems(0)
      .sName = "John Jones"
      .sAddress = "123 First Street"
      .sCity = "New York, NY"
   End With
   With m_udtMailingList.uMailItems(1)
      .sName = "Tom Smith"
      .sAddress = "456 Second Avenue"
      .sCity = "San Diego, CA"
   End With
   With m_udtMailingList.uMailItems(2)
      .sName = "Mayor Rizzo"
      .sAddress = "789 Third Street"
      .sCity = "Philadelphia PA"
   End With
         
   Dim intFreeFile As Integer: intFreeFile = FreeFile
   Open i_strFilePath For Binary As #1
   Put intFreeFile, , m_udtMailingList
   Close intFreeFile
   
End Sub

' <----- Code End ----->


0
 
LVL 1

Author Comment

by:nguyenn
Comment Utility
WSH,

With your codes, I cannot view the output XML document, i got an error when tried to display it:

A name contained an invalid character. Line 1, Position 14

To mflam,

In the first website, I cannot find MS-XML3 to download. Could you tell me where it is?

Thanks
0
 
LVL 14

Expert Comment

by:wsh2
Comment Utility
The missing variable, is because you forgot to add a Datagrid to Form1. Please follow the 8 instructions below, and everything will work.

1. Start a New Standard.Exe Project.
2. Add a DataGrid (DataGrid1) to Form1. (Vb Menu -> Project -> Components -> Microsoft DataGrid Control).
3. Add a Textbox (Text1) to Form1. Set the Multiline property to True and the Scrollbars property to 2-Vertical.
4. Set a Reference (VB Menu -> Project -> References) to "Microsoft ActiveX Data Objects 2.x Library"
5. Copy/Paste the following into the Form1 code window.
6. Change strFilePath to a temporary testing file path / name.
7. Change strFileXML to a temporary testing file path / name.
8. Press F5 to run. The datagrid will be filled with the test data and the test data will be saved as an XML file to strFileXML AND displayed in the Textbox.

<----- Code Begin ----->

Option Explicit

Private Type typMailing
  sName As String * 25
  sAddress As String * 25
  sCity As String * 25
End Type

Private Type typMailingList
  uMailItems() As typMailing
End Type

Private m_cn As ADODB.Connection
Private m_udtMailingList As typMailingList

Private Sub Form_Load()

'  Set the following Text1 properties as indicated
'  Text1.Multiline = True
'  Text1.ScrollBars = 2 - Vertical
 
With Screen
   Me.Move 0.1 * .Width, 0.1 * .Height, 0.8 * .Width, 0.8 * .Height
End With

   Dim strFilePath As String
   strFilePath = "c:\tempwork\test.dat"   ' <-- CHANGE ME
   Dim strFileXML As String
   strFileXML = "c:\tempwork\test.XML"   ' <-- CHANGE ME
 
'  Create Test Data
   Call x_Build_Test_Data(strFilePath)
 
'  Read Test Data
   Dim intFreeFile As Integer: intFreeFile = FreeFile
   Open strFilePath For Binary As intFreeFile
   Get intFreeFile, , m_udtMailingList
   Close intFreeFile
 
'  Create Recordset
   Dim m_rs As New ADODB.Recordset
   With m_rs
      .Fields.Append "Name", adVariant, , adFldMayBeNull
      .Fields.Append "Address", adVariant, , adFldMayBeNull
      .Fields.Append "City", adVariant, , adFldMayBeNull
      .Open
   End With
 
'  Load Recordset With Test Data
   Dim lngIndex As Long
   For lngIndex = LBound(m_udtMailingList.uMailItems) To UBound(m_udtMailingList.uMailItems)
      m_rs.AddNew
      With m_udtMailingList.uMailItems(lngIndex)
         m_rs.Fields(0) = Trim(.sName)
         m_rs.Fields(1) = Trim(.sAddress)
         m_rs.Fields(2) = Trim(.sCity)
      End With
      m_rs.Update
   Next lngIndex
 
'  Display RecordSet
   Set DataGrid1.DataSource = m_rs
 
'  Persist The Data (ie.. save it to disk as an XML file) To Disk

   Dim strBuffer As String
   Text1.Text = ""
   If Dir(strFileXML) <> "" Then Kill strFileXML
   Open strFileXML For Binary As intFreeFile
   With m_rs
      strBuffer = "<MyTable List>" & vbCrLf
      Put intFreeFile, , strBuffer
      Text1.Text = Text1.Text & strBuffer
      .MoveFirst
      Do Until .EOF
         For lngIndex = 0 To m_rs.Fields.Count - 1
            strBuffer = "<" & .Fields(lngIndex).Name & ">" _
               & .Fields(lngIndex).Value _
               & "<\" & .Fields(lngIndex).Name & ">" _
               & vbCrLf
            Put intFreeFile, , strBuffer
            Text1.Text = Text1.Text & strBuffer
         Next lngIndex
         .MoveNext
      Loop
      strBuffer = "<\MyTable List>" & vbCrLf
      Put intFreeFile, , strBuffer
      Text1.Text = Text1.Text & strBuffer
   End With

End Sub

Private Sub Form_Resize()
   
   With Me
      DataGrid1.Move 0, 0, .ScaleWidth, 0.5 * .ScaleHeight
      Text1.Move 0, 0.5 * .ScaleHeight, .ScaleWidth, 0.5 * .ScaleHeight
   End With

End Sub

Private Sub x_Build_Test_Data(ByVal i_strFilePath As String)

   If Dir(i_strFilePath) <> "" Then Kill i_strFilePath
 
   With m_udtMailingList
      ReDim .uMailItems(2)
   End With
   
   With m_udtMailingList.uMailItems(0)
      .sName = "John Jones"
      .sAddress = "123 First Street"
      .sCity = "New York, NY"
   End With
   With m_udtMailingList.uMailItems(1)
      .sName = "Tom Smith"
      .sAddress = "456 Second Avenue"
      .sCity = "San Diego, CA"
   End With
   With m_udtMailingList.uMailItems(2)
      .sName = "Mayor Rizzo"
      .sAddress = "789 Third Street"
      .sCity = "Philadelphia PA"
   End With
       
   Dim intFreeFile As Integer: intFreeFile = FreeFile
   Open i_strFilePath For Binary As #1
   Put intFreeFile, , m_udtMailingList
   Close intFreeFile
 
End Sub

<----- Code End ----->




0
 
LVL 3

Expert Comment

by:nzjonboy
Comment Utility
nguyenn, I hacked this together in access but you should be able to convert it to VB easily. It gets the recordset from the table and then writes the output to an xml file.

Function createXML()
On Error GoTo Err_createXML

    Dim RS As DAO.Recordset
    Dim strQuery As String
    Dim hFile As Integer
    Dim sFilename As String
    Dim i
   
    strQuery = "SELECT * FROM tCustomer"
    Set RS = CurrentDb.OpenRecordset(strQuery, dbOpenDynaset)
   
    'obtain the next free file handle from the system
    hFile = 1
    sFilename = "C:\demo.xml"
     
    'open and save the textbox to a file
    Open sFilename For Output As #hFile
    Print #hFile, "<CustomerList>" & vbCr
     
    'nguyenn - you need to put check code here just in case there are no records
     
    'loop here
    RS.MoveLast
    For i = 0 To RS.RecordCount - 1
   
        Print #hFile, "<CustomerID>" & RS.Fields("ID") & "</CustomerID>" & vbCr
        Print #hFile, "<CustomerName>" & RS.Fields("Name") & "</CustomerName>" & vbCr
        Print #hFile, "<CustomerAddress>" & RS.Fields("Address") & "</CustomerAddress>" & vbCr
       
    Next
    'end loop
     
    Print #hFile, "</CustomerList>"
    Close #hFile
   
   
    Set RS = Nothing

Exit_createXML:
    Exit Function
   
Err_createXML:
    Select Case Err.Number
        Case Else
            MsgBox "Error number: " & Err.Number & ". " & Err.Description
    End Select
    Resume Exit_createXML
End Function


hope this helps

nzjonboy
0
 
LVL 75

Accepted Solution

by:
Anthony Perkins earned 100 total points
Comment Utility
First of all an apology to those from PAXML (Programmers against XML) I did use XML istead of good old reliable BASIC I/O.  I trust you will forgive me!

Make a reference to ADO and XML.  If the version of XML you have is Version 2 than change all references to MSXML2 to MSXML.  I am using Microsoft's NorthWind database so change the connection and column names appropriately.

Private Sub Command1_Click()
Const XMLFile = "C:\CustomerList.xml"
Dim xmlDoc As MSXML2.DOMDocument
Dim rs As ADODB.Recordset

Set xmlDoc = New MSXML2.DOMDocument

' Create document root
Set xmlDoc.documentElement = xmlDoc.createElement("CustomerList")

Set rs = New ADODB.Recordset
With rs
   .Source = "Select * from Customers"
   .ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Temp\NWIND.MDB"
   .CursorType = adOpenForwardOnly
   .LockType = adLockReadOnly
   .Open Options:=adCmdText
   Do While Not .EOF
      ' Add the nodes
      AddNode xmlDoc, "CustomerID", !CustomerID
      AddNode xmlDoc, "CustomerName", !CompanyName
      AddNode xmlDoc, "CustomerAddress", !Address
      .MoveNext
   Loop
   .Close
End With
Set rs = Nothing

' Save xml file
xmlDoc.save XMLFile

MsgBox XMLFile & " is created."

End Sub

Private Sub AddNode(xmlDoc As MSXML2.DOMDocument, ByVal ElementName As String, ByVal ElementValue As String)
Dim xmlNode As MSXML2.IXMLDOMNode
     
Set xmlNode = xmlDoc.createElement(ElementName)
xmlNode.Text = ElementValue
xmlDoc.documentElement.appendChild xmlNode

End Sub

Anthony
0
 
LVL 1

Author Comment

by:nguyenn
Comment Utility
Thanks Anthony, you help me out very much.

Thanks everybody whom posted source codes and gave me bright suggestions, I'm very appreciate verything you done for me

Have a nice day :)
nguyenn
0

Featured Post

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now