Link to home
Start Free TrialLog in
Avatar of nguyenn
nguyenn

asked on

Need XML code sample

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
Avatar of JonFish85
JonFish85

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!
Avatar of nguyenn

ASKER

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>
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!
Avatar of nguyenn

ASKER

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
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 ----->
Avatar of nguyenn

ASKER

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>

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
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 ----->


Avatar of nguyenn

ASKER

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
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 ----->




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
ASKER CERTIFIED SOLUTION
Avatar of Anthony Perkins
Anthony Perkins
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of nguyenn

ASKER

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