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