Tuesday, July 7, 2009

XML connection using ADODB

First of all, make a form, last of add control following :

  1. Textbox
    Name = "Text1"
  2. Commandbutton
    Name = "Command1"
    Caption = "Create New"
  3. Commandbutton
    Name = "Command2"
    Caption = "Read"
  4. Listview
    Name = "Listview1"
    View = "3 - lvwReport


Ascertain control properties, arrange in such a manner. After you arrange it, inserting code following at your form:

Option Explicit

Private XML_ADO As Object

Private xd As String 'error description
Private xn As Long 'error number

Private Sub Command1_Click()
Dim question As String
On Error GoTo Error

Set XML_ADO = CreateObject("ADODB.Recordset")

With XML_ADO
.Fields.Append "Field1", adVarChar, 255
.Fields.Append "Field2", adVarChar, 255
.Fields.Append "Field3", adVarChar, 255

.Fields.Refresh

.Open

'if you want to insert data
.AddNew
.Fields(0).Value = "This field 1"
.Fields(1).Value = "This field 2"
.Fields(2).Value = "This field 3"
.Update

.Save Text1.Text, adPersistXML
End With

Set XML_ADO = Nothing

question = MsgBox("XML File created. Do you want to show data?", vbQuestion + vbYesNo, "Confirmation")

If question = vbNo Then Exit Sub

Command2_Click

Error:
xd = Err.Description
xn = Err.Number
If xn = 0 Then Exit Sub
MsgBox xd, vbCritical + vbOKOnly, "Error " & xn
Err.Clear
End Sub

Private Sub Command2_Click()
Dim i As Long
Dim cnt As Long
Dim ifor As Long
On Error GoTo Error

Set XML_ADO = CreateObject("ADODB.Recordset")

i = 1

ListView1.ColumnHeaders.Clear
ListView1.ListItems.Clear

With XML_ADO
.Open Text1.Text

cnt = .Fields.Count - 1

If cnt > 0 Then
For ifor = 0 To cnt
ListView1.ColumnHeaders.Add (ifor + 1), , .Fields(ifor).Name
Next
End If

If .RecordCount > 0 Then
Do While .EOF = False
For ifor = 0 To cnt
If ifor = 0 Then
ListView1.ListItems.Add i, , .Fields(ifor).Value
Else
ListView1.ListItems(i).SubItems(ifor) = .Fields(ifor).Value
End If
Next
i = i + 1
.MoveNext
Loop
End If
End With

Set XML_ADO = Nothing

Error:
xd = Err.Description
xn = Err.Number
If xn = 0 Then Exit Sub
MsgBox xd, vbCritical + vbOKOnly, "Error " & xn
Err.Clear
End Sub


No comments:

Post a Comment