Append Records using VB and Where clause

[tinkertek]

Hi,

I have 2 similar Access 97 databases residing on 2 different servers. Let's call them \\Server1\DB1.mdb and \\Server2\DB2.mdb. Every day, I need to Append records to DB1.mdb using records from DB2.mdb, but don't want to create duplicates in DB1.mdb either. Any ideas how to code this using VB6 ? If not, what code in Access would work >

Thanks for any help !!!!

Tinkertek

 

[bjrollet]

I think this is pretty easy. First, cretae a recordset of the data you want to copy. Then open the table you want to append to as a recordset. Then all you have to do is loop through the first recordset adding records to the second as you go.

rs1.open "Select * from table1", conn
rs2.open "Table1", conn, , , adCmdTable

do until rs1.EOF
rs2.addnew
rs2.("Field1&quot=rs1.("Field1&quot
rs2.("Field2&quot=rs1.("Field1&quot
etc...
rs2.update
rs1.movenext
loop

rs1.close
rs2.close

This is something pretty close to what you need to do. Just not tooooo sure of the parameters used to open the recordsets.

If you need more help, just holler.

 

[bjrollet]

Sorry, the second line should read:

rs2.open "Table2", conn, adOpenDynamic, adLockOptomistic, adCmdTable

 

[tinkertek]

Thanks for the reply. I'll give it a try. I have to be careful not to add duplicate records to the appended table. I'm not that great using VB6, so I'll try to muddle through.

Tinkertek

 

[bjrollet]

Checking for duplicate records is easy enough. Just after you enter the do loop, before you perform the addnew method on rs2, open another recordset on the table you wish to add to, using the crieria you want to add. If the query returns an empty recordset, then you know the record you wish to add is not a duplicate.

 

[tinkertek]

I'm lost !!! I've got hours into this and can't make it work properly. Call me dense. What would the complete code be ? Thanks again for any help !

 

[bjrollet]

I haven't run this, but it should work. First, you need to set up two DSN's for your data sources. Next, start a new .exe project and add a command button to the form.

Option Explicit
Dim objCN1 As ADODB.Connection
Dim objCN2 As ADODB.Connection
Dim objRS1 As ADODB.Recordset
Dim objRS2 As ADODB.Recordset
Dim objRS3 As ADODB.Recordset

Private Sub Command1_Click()

Set objCN1 = New ADODB.Connection
Set objCN2 = New ADODB.Connection
Set objRS1 = New ADODB.Recordset
Set objRS2 = New ADODB.Recordset
Set objRS3 = New ADODB.Recordset

objCN1.Open "DSN=TEST"
objCN2.Open "DSN=TEST2"

objRS1.Open "SELECT * FROM TABLE1", objCN1, adOpenForwardOnly, adLockReadOnly  'Records to copy
objRS2.Open "TABLE2", objCN2, adOpenDynamic, adLockBatchOptimistic, adCmdTable  'Table to copy to

Do Until objRS1.EOF
    objRS3.Open "SELECT FIELD FROM TABLE2 WHERE KeyValue=" & objRS1("KeyValue"), objCN2, adOpenForwardOnly, adLockReadOnly  'Check for existing record
    If objRS3.EOF Then      'If EOF is TRUE, then the record does not exist
        objRS2.AddNew       'Add the record
        objRS2("Field1") = objRS1("Field1")
        objRS2("Field2") = objRS1("Field2")
        objRS2("Field3") = objRS1("Field3")
        objRS2("Field4") = objRS1("Field4")
        objRS2("Field5") = objRS1("Field5")
        objRS2.Update
    End If
    objRS1.MoveNext  'Move to next record to test and copy
    objRS3.Close  'Close the test recordset so we can open it again
Loop

objRS1.Close  'Cleanup
objRS2.Close
objCN1.Close
objCN2.Close
Set objRS1 = Nothing
Set objRS2 = Nothing
Set objRS3 = Nothing
Set objCN1 = Nothing
Set objCN2 = Nothing

End Sub

Private Sub Form_Load()



End Sub

 

[tinkertek]

Hi BJRollet,

Wow, you went through all that work for me ! That's awesome. I can't wait to try it out. I was way off.

I'll try it tommorrow or Friday and will let you know !

Thanks again !!!!
Tinkertek

 

[CCLINT]

There is a easier way:
If you can set a unique key on one of the fields in DB1 then do so. Otherwise, add one at run time, and after doing the append,(using ALTER TABLE, ADD CONSTRAINT, DROP CONSTRAINT), remove it (Using DAO in this example).

The use EXECUTE with something like :

myDb.EXECUTE "INSERT INTO myTable1
SELECT *
FROM myTable2 IN "D:\myPath\DB1.Mdb"

myDb being DB2

If you not use dbFailOnError constant for the EXECUTE options, the EXECUTE will add all unique fields with-out erroring out on duplicates.

 

[tinkertek]

Hi bjrollet,

I tried out the code and got this error after several seconds: Run-time error 2147217904 (80040e10) [Microsoft][ODBC Microsoft Access Driver] Too =
few parameters. Expected 1.
Source: Microsoft OLE DB Provider for ODBC Drivers

Here is the code as I compiled it:

Option Explicit
Dim objCN1 As ADODB.Connection
Dim objCN2 As ADODB.Connection
Dim objRS1 As ADODB.Recordset
Dim objRS2 As ADODB.Recordset
Dim objRS3 As ADODB.Recordset

Private Sub Command1_Click()

'Open connection to databases and recordsets, objCN1 = CT database, objCN2=Lawnt02 database
Set objCN1 = New ADODB.Connection
Set objCN2 = New ADODB.Connection
Set objRS1 = New ADODB.Recordset
Set objRS2 = New ADODB.Recordset
Set objRS3 = New ADODB.Recordset

objCN1.Open "DSN=Inventory_be_ct"
objCN2.Open "DSN=Inventory_be"

objRS1.Open "SELECT * FROM Assets", objCN1, adOpenForwardOnly, adLockReadOnly 'Records to copy
objRS2.Open "Assets", objCN2, adOpenDynamic, adLockBatchOptimistic, adCmdTable 'Table to copy to

Do Until objRS1.EOF
objRS3.Open "SELECT BarcodeNumber FROM Assets WHERE BarcodeNumber=" & objRS1("BarcodeNumber&quot, objCN2, adOpenForwardOnly, adLockReadOnly 'Check for existing record
If objRS3.EOF Then 'If EOF is TRUE, then the record does not exist
objRS2.AddNew 'Add the record
objRS2("BarcodeNumber&quot = objRS1("BarcodeNumber&quot
objRS2("AssetDescription&quot = objRS1("AssetDescription&quot
objRS2("Make&quot = objRS1("Make&quot
objRS2("Model&quot = objRS1("Model&quot
objRS2("SerialNumber&quot = objRS1("SerialNumber&quot
objRS2("Year Of Manufacture&quot = objRS1("Year of Manufacture&quot
objRS2("Options&quot = objRS1("Options&quot
objRS2("Firmware&quot = objRS1("Firmware&quot
objRS2("Status&quot = objRS1("Status&quot
objRS2("Repair History&quot = objRS1("Repair History&quot
objRS2("Region&quot = objRS1("Region&quot
objRS2("State&quot = objRS1("State&quot
objRS2("Site&quot = objRS1("Site&quot
objRS2("Comments&quot = objRS1("Comments&quot
objRS2("Rack&quot = objRS1("Rack&quot
objRS2("Row&quot = objRS1("Row&quot
objRS2("Slot&quot = objRS1("Slot&quot
objRS2("UpdatedBy&quot = objRS1("UpdatedBy&quot
objRS2("Channel&quot = objRS1("Channel&quot
objRS2("Address&quot = objRS1("Address&quot
objRS2("CalibrationDate&quot = objRS1("CalibrationDate&quot
objRS2("ReminderEmail&quot = objRS1("ReminderEmail&quot
objRS2.Update
End If
objRS1.MoveNext 'Move to next record to test and copy
objRS3.Close 'Close the test recordset so we can open it again
Loop

objRS1.Close 'Cleanup
objRS2.Close
objCN1.Close
objCN2.Close
Set objRS1 = Nothing
Set objRS2 = Nothing
Set objRS3 = Nothing
Set objCN1 = Nothing
Set objCN2 = Nothing

End Sub

Private Sub Form_Load()



End Sub

Thanks for any help !

 

[bjrollet]

What line did you get the error on???

 

[CCLINT]

ADO - appending data from one table in one database to another table in a 2nd database. The error

Sub test()

Dim cn As ADODB.Connection
Dim dbError As ADODB.Error

On Error GoTo ErrHandler

Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=E:\DB1\myDB1.MDB;"

cn.Execute "INSERT INTO Customer " _
& "SELECT * " _
& "FROM Customer " _
& "IN C:\DB2\myDB2.MDB'"

ExitProceedure:
Exit Sub
ErrHandler:
For Each dbError In cn.Errors
If dbError.SQLState = 3022 Then
'Ignor duplicates - in order for this to work you
'need to set a unique key in the receiving DB


Else
MsgBox "Error: " & Err.Number - vbObjectError & vbCr & Err.Description
End If
Next dbError
Resume ExitProceedure
End Sub

 

[tinkertek]

Hi bjrollet,

I don't know which line is causing the error. You won't believe this, but I do not have VB at work, I only have it at home. So, I have to write the code at home, use the Package and Deployment Wizard, then email it to work, then go to work and run the setup file, then actually run it to test. It's insane, the good news is, my boss says he's trying to get me VB, we'll see.

Hi CCLINT,

I don't understand how you're code example works, as I am not at all familiar with ADO. I do not have a unique key in either database. Can I use just an autonumber field for this. And, if so, in which database ? Is your Test Sub() the complete code, I can just edit it to match my database names and paths ? If so, which References do I need in VB ?

Thankyou both for the help !!!!

 

[tinkertek]

Well, I set this whole thing up on my home computer and finally figured out the line that is causing the error, "Too few parameters expected 1"

objRS3.Open "SELECT BarcodeNumber FROM Assets WHERE BarcodeNumber=" & objRS1("BarcodeNumber&quot, objCN2, adOpenForwardOnly, adLockReadOnly 'Check for existing record

Any ideas ?

Thanks,
Tinkertek

 

[CCLINT]

Yes, you can use an auto number field - this should be unique. I have been using this with DAO for several years and changed it to ADO as above and it ran fine (I use this for combining two identical DBs, and the customers who have used this in the past have never had a problem. The only issue that you may have is when the databases are secured (like mine are). You will have to supply the passwords in the connection string and select statement.
Give it a try and a test - create 2 mdbs locally with one table each and an auto number field (create one and copy the other to a seperate path). The add the references for ADO and add the code above, changing the paths and mdb names....

Please be aware that if you are working with two Jet MDBs, then DAO will be the fastest....

 

[tinkertek]

Hi CCLINT,

I tried out your code and keep getting an error "syntax error in FROM clause". Here's the code:

Sub command1_click()

Dim cn As ADODB.Connection
Dim dbError As ADODB.Error

On Error GoTo ErrHandler

Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient
cn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=C:\ct\headend inventory_be_ct.mdb;"

cn.Execute "INSERT INTO Assets " _
& "SELECT * " _
& "FROM Assets " _
& "IN C:\my documents\headend inventory_be.mdb"

ExitProceedure:
Exit Sub
ErrHandler:
For Each dbError In cn.Errors
If dbError.SQLState = 3022 Then
'Ignor duplicates - in order for this to work you
'need to set a unique key in the receiving DB


Else
MsgBox "Error: " & Err.Number - vbObjectError & vbCr & Err.Description
End If
Next dbError
Resume ExitProceedure
End Sub

 

[CCLINT]

Your missing the single quotes around the database path and name....
(In my example I was missing one of them as well.

 

[tinkertek]

Hi CCLINT,

I fixed the single quote as you said and now it seems to function. However, it only copies the source database to itself, not to the destination database. It creates all kinds of duplicates in itself.

What a nightmare trying to get this project done !

I created a unique autonumber key in the destination database and created a autonumber key in the source. But, in the source, I didn't make it unique, but it probably is anyway. Tried various combinations of unique and not unique and it didn't seem to help. It seems I need to have the exact same fields in both databases though.

Maybe I should try to do this in DAO, rather than ADO ?

 

[CCLINT]

Make sure that the Assets table in the inventory_be_ct is the one with the autonumber unique field.

I tested with the code that you posted (ADO) and it works fine (after adding the quotes)

 

[tinkertek]

Thankyou for your help !