DB Convert From Access

I am currently in the process of writing an application to convert an Access database to SQL. Basically, I have created an odbc link in access and then I transfer the data from the access table to the linked table.

The problem is where I have to transfer the Identity keys. I can transfer all the data but the keys. They will auto increment. I tried using INSERT_IDENTITY tablename ON but it just returns an error mosty of the time. I have gotten it to transfer once or twice by stepping through.

Here is the basic code:

The code that causes everything to error is commented out.


Private Sub CopySQLRecordSet(ByVal stTableName As String, _
Optional ByVal blIdentity As Boolean = True, _
Optional ByVal stSearch As String = "")
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Set cat = New ADOX.Catalog
Set tbl = New ADOX.Table
Dim adoCommand As New ADODB.Command, stCommand As String
Dim adoSQLCommand As New ADODB.Command
Dim errorString As String

On Error GoTo ErrorCopying
PrgPart.Value = PrgPart.Value + 1
If blCancelPressed Then End '???fix later
cat.ActiveConnection = db1 'This doesn't seem to work with our normal settings for spectrumDbase
tbl.ParentCatalog = cat
tbl.Name = "dbo_" & stTableName
tbl.Properties("Temporary Table") = False
'possibly, this line will work for Oracle as well
tbl.Properties("Jet OLEDB:Link Provider String") = "odbc;DSN=
;DATABASE=database;"
tbl.Properties("Jet OLEDB:Remote Table Name") = stTableName
tbl.Properties("Jet OLEDB:Create Link") = True
tbl.Properties("Jet OLEDB:Table Hidden In Access") = False
tbl.Properties("Jet OLEDB:Cache Link Name/Password") = False
cat.Tables.Append tbl
Suspend 1
adoCommand.CommandType = adCmdText
adoCommand.ActiveConnection = database
adoSQLCommand.CommandType = adCmdText
adoSQLCommand.ActiveConnection = rsDbase

'spectrumDBase.BeginTrans
'stCommand = "BEGIN TRANSACTION " & vbNewLine _
' & "go" & vbNewLine
'If there is an identity field in the table, it must be temporarily disabled
'to insert from an foreign DB.
'If blIdentity Then
' stCommand = stCommand & "SET IDENTITY_INSERT dbo_" & stTableName & " ON " & vbNewLine & "GO" & vbNewLine
'adoCommand.CommandText = stCommand
'adoCommand.Execute
'End If

'insert the records from the source table
stCommand = ""
stCommand = stCommand & "INSERT INTO dbo_" & stTableName _
& " SELECT * FROM " & stTableName & vbNewLine _
& "GO" & vbNewLine

'stCommand = stCommand & "COMMIT TRANSACTION"

adoCommand.CommandText = stCommand
adoCommand.Execute

'clean up
' stCommand = stCommand & vbNewLine & "DROP TABLE dbo_" & stTableName & vbNewLine & "GO"
' adoCommand.CommandText = stCommand
' adoCommand.Execute

'reinsert identity property
' If blIdentity Then stCommand = "SET IDENTITY_INSERT " & stTableName & " OFF" & vbNewLine

'Block statement, going to leave this out for now
'stCommand = stCommand & "go" & vbNewLine _
'& "COMMIT TRANSACTION"

'adoCommand.CommandText = stCommand
'adoCommand.Execute

Set adoCommand = Nothing
Set adoSQLCommand = Nothing
Exit Sub
ErrorCopying:
'need to save this to a string so it doesn't reset when Resume occurs
errorString = Err.Description
' MsgBox "Error copying the [" & stTableName & "] table." & vbNewLine _
' & "Error: " & errorstring
Resume errorCatch
errorCatch:
On Error Resume Next
'set a log
Dim fso As FileSystemObject, fStream As TextStream
Set fso = New FileSystemObject
Set fStream = fso.OpenTextFile(App.Path & "DBTransfer.log", ForAppending, True)
fStream.WriteLine "***Error copying the [" & stTableName & "] table."
fStream.WriteLine " Error: " & errorString
fStream.WriteLine " "
fStream.Close
Set fStream = Nothing
Set fso = Nothing
'clean up
adoCommand.CommandText = "DROP TABLE dbo_" & stTableName
adoCommand.Execute
If blIdentity Then
'reinsert identity property
adoSQLCommand.CommandText = "SET IDENTITY_INSERT " & stTableName & " OFF"
adoSQLCommand.Execute
End If
Set adoCommand = Nothing
Set adoSQLCommand = Nothing
End Sub