Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Need XML code sample

Posted on 2001-08-22
13
Medium Priority
?
398 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
ID: 6413761
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
ID: 6413804
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
ID: 6413836
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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 1

Author Comment

by:nguyenn
ID: 6413895
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
ID: 6414047
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
ID: 6414116
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
 
LVL 2

Expert Comment

by:mflam
ID: 6414251
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
ID: 6414656
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
ID: 6414738
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
ID: 6415354
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
ID: 6415869
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 400 total points
ID: 6416121
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
ID: 6417371
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

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Suggested Courses
Course of the Month12 days, 16 hours left to enroll

971 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