Summary This program helps to download all the datas from the database and writes it in XML. The database used is (sql 7.0) and VB6.0

Additional information

Private fsoFileScriptingObject As New Scripting.FileSystemObject Private XMLFile As Scripting.TextStream Private Sub Command1_Click() Dim adoConnection As New ADODB.Connection Dim adoRecordset_sysName As New ADODB.Recordset Dim adoRecordset_sysCount As New ADODB.Recordset Dim adoRecordset_tableName As New ADODB.Recordset Dim adoRecordset_tableDef As New ADODB.Recordset Dim adoRecordset_tableDef1 As New ADODB.Recordset Dim adoRecordset_tableCount As New ADODB.Recordset Dim connectString As String On Error GoTo errorHandler Dim value As String Dim dname As String Dim loc_img As Integer Dim ud As String Dim tname As String Dim col_name As String Dim col_name1 As String ud = "u" Dim rowarray() Dim colarray() Dim sysarray() Dim countloop1 As Integer countloop1 = 0 Bar1.value = 1 dname = databaseName.Text connectString = "data source=" & dSource & ";uid=" & uid & ";pwd=" & pwd & ";database=" & dname & ";" adoConnection.Open connectString adoRecordset_sysName.Open "select * from sysobjects where xtype=" & "'" & ud & "'", adoConnection adoRecordset_sysCount.Open "select count(*) from sysobjects where xtype=" & "'" & ud & "'", adoConnection Do Until adoRecordset_sysCount.EOF countre = adoRecordset_sysCount(0) adoRecordset_sysCount.MoveNext Loop ReDim sysarray(countre) '******************************* Do Until adoRecordset_sysName.EOF tname = adoRecordset_sysName(0) Dim count As Integer Dim colcount As Integer count = 0 colcount = 0 '********************************** Dim sql As String sql = "SELECT * FROM " & tname adoRecordset_tableName.Open sql, adoConnection adoRecordset_tableDef.Open "sp_columns " & tname, adoConnection adoRecordset_tableDef1.Open "sp_columns " & tname, adoConnection adoRecordset_tableCount.Open "select count(*) from " & tname, adoConnection '********************************* Bar1.value = 2 Do Until adoRecordset_tableCount.EOF count = adoRecordset_tableCount(0) adoRecordset_tableCount.MoveNext Loop loc_img = 0 '********************************** Do Until adoRecordset_tableDef.EOF If adoRecordset_tableDef("column_name") <> "" Then col_name = adoRecordset_tableDef("column_name") End If If adoRecordset_tableDef("type_name") = "image" Then loc_img = loc_img + 1 col_name1 = col_name End If colcount = colcount + 1 adoRecordset_tableDef.MoveNext Loop ReDim colarray(colcount) ReDim rowarray(count) '******************************************* Do Until adoRecordset_tableDef1.EOF colarray(i) = adoRecordset_tableDef1("column_name") i = i + 1 adoRecordset_tableDef1.MoveNext Loop i = 0 j = 0 l = 0 If countloop1 = 0 Then Set XMLFile = fsoFileScriptingObject.CreateTextFile("" & dname & ".xml") End If With XMLFile If countloop1 = 0 Then .WriteLine "<?xml version='1.0'?>" .WriteLine "<" & dname & ">" End If Bar1.value = 3 Do Until adoRecordset_tableName.EOF .Write "<" & tname & ">" For k = 0 To colcount - 1 .Write "<" & colarray(k) & ">" If adoRecordset_tableName(k).ActualSize = "0" Then .Write "" Else If colarray(k) = col_name1 And loc_img <> 0 Then .Write "Image file" Else value = adoRecordset_tableName(k) value = Replace(value, "&", "&") value = Replace(value, "<", "<") value = Replace(value, ">", ">") value = Replace(value, "'", "'") value = Replace(value, "ß", "beta") value = Replace(value, "ü", "u") value = Replace(value, "ú", "u") value = Replace(value, "ö", "o") value = Replace(value, "ó", "o") value = Replace(value, "ô", "o") value = Replace(value, "æ", "ae") value = Replace(value, "Å", "A") value = Replace(value, "ä", "a") value = Replace(value, "å", "a") value = Replace(value, "á", "a") value = Replace(value, "à", "a") value = Replace(value, "ã", "a") value = Replace(value, "â", "a") value = Replace(value, "è", "e") value = Replace(value, "é", "e") value = Replace(value, "ê", "e") value = Replace(value, "í", "i") value = Replace(value, "ñ", "n") value = Replace(value, "ç", "c") .Write value End If End If .Write "</" & colarray(k) & ">" Next adoRecordset_tableName.MoveNext .WriteLine "</" & tname & ">" Loop adoRecordset_tableName.Close Set adoRecordset_tableName = Nothing adoRecordset_sysName.MoveNext countloop1 = countloop1 + 1 End With adoRecordset_tableDef.Close adoRecordset_tableDef1.Close adoRecordset_tableCount.Close Loop XMLFile.WriteLine "</" & dname & ">" XMLFile.Close Set XMLFile = Nothing Bar1.value = 4 MsgBox ("Xml File Downloaded") Bar1.value = 0 adoRecordset_sysCount.Close adoConnection.Close Exit Sub errorHandler: MsgBox Str(Err) + " - " + Error$, vbInformation, "Error Report" Bar1.value = 0 End Sub Private Sub cmdReset_Click() dSource.Text = "" uid.Text = "" pwd.Text = "" databaseName.Text = "" End Sub