Importing with ADO

[Thai]

Is it possible to import a table with ADO or ADOX?

Thanks,
Thai

[Clunietp]

what/where are you importing from/to?

[Thai]

importing an ms access 97 to an ms access 97.

thanks,
Thai

[Clunietp]

OK, I just recreated a big portion of the DTS code for you :)


Private Sub Form_Load()

Dim strTableName As String
Dim strSourceConnStr As String
Dim strDestinationConnStr As String

strTableName = "Customers"
strSourceConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Nwind2k.mdb"
strDestinationConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=Nwindnew.mdb"

Call CopyTable(strTableName, strSourceConnStr, strDestinationConnStr, True)
Call CopyData(strTableName, strSourceConnStr, strDestinationConnStr, True)

End Sub
Public Sub CopyData(TableName As String, SourceConnectionString As String, DestinationConnectionString As String, DeleteExistingData As Boolean)

On Error GoTo Err_Handler

Dim cnSource As ADODB.Connection
Dim cnDestination As ADODB.Connection
Dim rsSource As ADODB.Recordset

Dim strSQL As String
Dim lngCounter As Long

Set cnSource = New Connection
Set cnDestination = New Connection

'open connections
cnSource.Open SourceConnectionString
cnDestination.Open DestinationConnectionString

'start transaction for destination in case of error
cnDestination.BeginTrans

'get source data
Set rsSource = cnSource.Execute("Select * from [" & TableName & "]", , adCmdText)

'delete data if necessary
If DeleteExistingData = True Then
cnDestination.Execute "Delete from [" & TableName & "]"
End If

Do Until rsSource.EOF = True
'prepare SQL statement
'==============================================
strSQL = "Insert into [" & TableName & "] ("

'get fields
For lngCounter = 0 To rsSource.Fields.Count - 1
strSQL = strSQL & "[" & rsSource.Fields(lngCounter).Name & "], "
Next lngCounter

'remove last comma & space
strSQL = Left(strSQL, Len(strSQL) - 2)

strSQL = strSQL & ") VALUES ("

'get data
For lngCounter = 0 To rsSource.Fields.Count - 1
strSQL = strSQL & "'" & Replace(rsSource.Fields(lngCounter).Value & "", "'", "''") & "', "
Next lngCounter

'remove last comma & space
strSQL = Left(strSQL, Len(strSQL) - 2)

'add closing parenthesis
strSQL = strSQL & ")"

'update destination table
cnDestination.Execute strSQL, , adCmdText

rsSource.MoveNext
DoEvents
Loop
'commit transaction
cnDestination.CommitTrans
Exit Sub

Err_Handler:
cnDestination.RollbackTrans
Err.Raise Err.Number, Err.Source, Err.Description
End Sub

Public Sub CopyTable(TableName As String, SourceConnectionString As String, DestinationConnectionString As String, DropExisting As Boolean)

Dim cnSource As ADODB.Connection
Dim cnDestination As ADODB.Connection

Dim objSourceCat As ADOX.Catalog
Dim objDestinationCat As ADOX.Catalog

Dim objSourceTable As ADOX.Table
Dim objDestinationTable As ADOX.Table

Dim objColumn As ADOX.Column
Dim objKey As ADOX.Key

Dim lngCounter As Long
Dim blnFoundTable As Boolean

Set cnSource = New Connection
Set cnDestination = New Connection

'source db
cnSource.Open SourceConnectionString

'destination db
cnDestination.Open DestinationConnectionString

Set objSourceCat = New Catalog
Set objDestinationCat = New Catalog

'get source table
objSourceCat.ActiveConnection = cnSource
objDestinationCat.ActiveConnection = cnDestination

Set objSourceTable = objSourceCat.Tables(TableName)

'delete existing table if required
If DropExisting = True Then
For lngCounter = 0 To objDestinationCat.Tables.Count - 1
If objDestinationCat.Tables(lngCounter).Name = TableName Then
blnFoundTable = True
Exit For
End If
Next lngCounter

If blnFoundTable = True Then
objDestinationCat.Tables.Delete TableName
End If
End If

'create destination table
Set objDestinationTable = New Table
objDestinationTable.Name = objSourceTable.Name

'append columns to destination table
For Each objColumn In objSourceTable.Columns
objDestinationTable.Columns.Append objColumn.Name, objColumn.Type, objColumn.DefinedSize
Next objColumn

'append keys to destination table
For Each objKey In objSourceTable.Keys
objDestinationTable.Keys.Append objKey.Name, objKey.Type, objKey.Columns(0).Name, objKey.RelatedTable
Next objKey

'append table to destination catalog
objDestinationCat.Tables.Append objDestinationTable

'cleanup
cnSource.Close
cnDestination.Close

Set cnSource = Nothing
Set cnDestination = Nothing
Set objSourceCat = Nothing
Set objDestinationCat = Nothing
Set objKey = Nothing
Set objColumn = Nothing
Set objSourceTable = Nothing
Set objDestinationTable = Nothing

End Sub