TransferTable

Public Sub TransferTable( Userid1 As String, Password1 As String, dsn1 As String, _
table1 As String, UserID2 As String, Password2 As String, Dsn2 As String, table2 As String )

'Local variables


Dim Rdcn1 As rdoConnection 'Used RDO2.0 connection
Dim Rdors1 As rdoResultset
Dim Rdcn2 As rdoConnection
Dim Rd2 As rdoResultset
Dim NFields As Single
Dim Iarr As Integer
Dim Arrfields() As Single `Declared array For assemble fields count
Dim Arrstr As String
Dim Connect1 As String
Dim Connect2 As String
connect1 = ("uid=" & Userid1 & ";pwd=" & Password1 & ";") `Connect
string
connect2 = ("uid=" & UserID2 & ";pwd=" & Password2 & ";")
Set Rdcn1 = rdoEngine(0).OpenConnection(dsn1,rdDriverNoPrompt , ,connect1)
Set Rdors1 = Rdcn1.OpenResultset("select * from " & table1, rdOpenStatic)
'Select from table which will be transferred.

Nfields = Rdors1.rdoColumns.Count 'Count fields in table
Set Rdcn2 = rdoEngine(0).OpenConnection(Dsn2,rdDriverNoPrompt , , connect2)
'Connect to second database which will be receive data

ReDim Preserve ARRFIELDS(NFIELDS - 1)
Rdors1.MoveFirst
Arrstr = ""
Dim datafield As String
Dim letter As String
Dim countletter As Single
Dim b As Integer
Do Until Rdors1.EOF
For iARR = 0 To UBound(ARRFIELDS) `Loop for concatenating
String For INSERT into table in second database
datafield = Rdors1(iarr) & ""
Arrstr = Arrstr & "'"
datafield = checkApostrof(datafield) `Call procedure to
`check field value On having
`Apostrophe and change it On
'double Apostrophe

Arrstr = Arrstr & datafield
Arrstr = Arrstr & "'"
Arrstr = Arrstr & ","
Next iarr
Arrstr = Mid(Arrstr, 1, Len(Arrstr) - 1)
Set Rd2 = Rdcn2.OpenResultset("INSERT INTO " _
& table2 & " VALUES(" & Arrstr & ")")
Rdors1.MoveNext
Loop
MsgBox "Transfer Complete"
End Sub

` Function For check field on apostrophe

Private Function checkApostrof(checkField As String)
Dim new_text As String
Dim n As Integer, iL As Integer
n = InStr(checkField, "'")
If n = 0 Then
checkApostrof = checkField
Exit Function
End If
iL = Len(checkField)
For n = 1 To iL
If Mid(checkField, n, 1) = "'" Then
new_text = new_text & "''"
Else
new_text = new_text & Mid(checkField, n, 1)
End If
Next n
checkField = new_text
checkApostrof = checkField
End Function

'This is example how to use this class

'Put code below in Command button click Event and enjoy!

'P.S. Don't forget create table With the same fields count and

'datatypes in `receiving database.

'Example below Transfers table from Sybase to Oracle


Private Sub Command1_Click()
Dim userSybase As String `User id
Dim userOracle As String
Dim PasSybase As String
Dim pasOracle As String
Dim dsnSybase As String
Dim DsnOracle As String
Dim tableOr As String
Dim tableSy As String
userOracle = InputBox("UserID oracle")
userSybase = InputBox("userid Sybase")
pasOracle = InputBox("Password Oracle")
PasSybase = InputBox("password Sybase")
DsnOracle = InputBox("Dsn Oracle")
dsnSybase = InputBox("dsn Sybase")
tableOr = InputBox("Table oracle")
tableSy = InputBox("table sybase")
Dim oTran As New Class1
oTran.TransferTable userSybase, PasSybase, dsnSybase, tableSy, _
userOracle, pasOracle, DsnOracle, tableOr
End Sub
Inputs:

Userid1 As String - Input user Id for connecting to database
(for example for 'Oracle "SCOTT"

Password1 As String - Input user password
(for example for Oracle "TIGER"

dsn1 As String - DSN name of the connection ;
(for example "ORA1"-any name

table1 As String - table which will be transferred
-the same parameters for the second, recieving database

UserID2 As String, _
Password2 As String, _
Dsn2 As String, _
table2 As String -
Don't forget create table with the same fields count
and 'datatypes in receiving database