Function Test()
On Error GoTo Err_Test
' Dim Current Connection
Dim curDB As New ADODB.Connection
Dim curRS As New ADODB.Recordset
'Dim Link Database
Dim lnkDB As New ADODB.Connection
Dim lnkRS As New ADODB.Recordset
Dim lnkSTR As String
Dim lnkCNT As Long
Dim n As Long
' Set Current Recordset
Set curDB = CurrentProject.Connection
curRS.Open "tblTest", curDB, adOpenStatic, adLockPessimistic
'Set Link Recordset
lnkSTR = "Driver={Microsoft Access Driver (*.mdb)};" & _
"Dbq=SecuredDB.mdb;" & _
"SystemDB=Workgroup.mdw;" & _
"Uid=USER;Pwd=PASSWORD"
lnkDB.Open lnkSTR
lnkRS.Open "tblUserLogin", lnkDB, adOpenStatic, adLockPessimistic
n = 0
lnkCNT = lnkRS.RecordCount
If curRS.RecordCount = 0 Then curRS.AddNew Else curRS.MoveLast
lnkRS.MoveFirst
Do While n < lnkCNT
curRS.Fields("DatabaseUserName") = lnkRS.Fields("DatabaseUserName")
curRS.Fields("NetworkUserName") = lnkRS.Fields("NetworkUserName")
curRS.Fields("LogInDate") = lnkRS.Fields("LogInDate")
curRS.Fields("LogInTime") = lnkRS.Fields("LogInTime")
curRS.Fields("LogOutTime") = lnkRS.Fields("LogOutTime")
curRS.Fields("ID") = lnkRS.Fields("ID")
curRS.Update
curRS.AddNew
lnkRS.MoveNext
n = n + 1
Loop
MsgBox n
lnkRS.Close
lnkDB.Close
curRS.Close
curDB.Close
Exit_Test:
Exit Function
Err_Test:
lnkRS.Close
lnkDB.Close
curRS.Close
curDB.Close
MsgBox Err.Number & " - " & Err.Description
Resume Exit_Test
End Function