Evening, I have an Excel Spreedsheet which is used throughout the
Office to track assignments given to each staff member. I am now
wanting to add a worksheet which will track staff contacts and upload
that information to a Center Database (Table aready exist). I wrote
the following code to check for records already in the Database and
update them -if necessary, And also to add new records as needed. But
I continue to have Loop problems, and suggestions...



Sub DatabaseTransfer()
'
'
Dim dbs As Database
Dim rs As Recordset
Dim adjlog As String
Dim notfound As Boolean

adjlog = "\\xxxx.mdb"
Set dbs = OpenDatabase(adjlog)
Set rs = dbs.OpenRecordset("TEntry", dbOpenTable)
notfound = True
For R = 4 To 300
ColE = ActiveDocument.Cells(R, 5).Value
If ColE = "" Then
Exit For
End If
Do While Not rs.EOF
If ActiveDocument.Cells(1, 5).Value = rs.Fields("Login") _
And ActiveDocument.Cells(R, 5).Value = rs.Fields("SSN") Then
rs.Edit
rs.Fields("Login") = Range("F" & 1).Value 'Login is static
rs.Fields("From") = ActiveDocument.Cells(R, 3).Value
rs.Fields("Type") = ActiveDocument.Cells(R, 4).Value
rs.Fields("Date/Time") = ActiveDocument.Cells(R, 2).Value
rs.Fields("SSN") = ActiveDocument.Cells(R, 5).Value
rs.Fields("Claimant") = ActiveDocument.Cells(R, 6).Value
rs.Fields("OthPhone") = ActiveDocument.Cells(R, 7).Value
rs.Fields("Employer") = ActiveDocument.Cells(R, 9).Value
rs.Fields("Contact") = ActiveDocument.Cells(R, 10).Value
rs.Fields("OthEPhone") = ActiveDocument.Cells(R, 11).Value
rs.Fields("Action") = ActiveDocument.Cells(R, 12).Value
rs.Fields("Remarks") = ActiveDocument.Cells(R, 13).Value
rs.Update
notfound = False
Exit Do
Loop
Next
Else
rs.MoveNext
rs.AddNew
rs.Fields("Login") = Range("F" & 1).Value
rs.Fields("From") = ActiveDocument.Cells(R, 3).Value
rs.Fields("Type") = ActiveDocument.Cells(R, 4).Value
rs.Fields("Date/Time") = ActiveDocument.Cells(R, 2).Value
rs.Fields("SSN") = ActiveDocument.Cells(R, 5).Value
rs.Fields("Claimant") = ActiveDocument.Cells(R, 6).Value
rs.Fields("OthPhone") = ActiveDocument.Cells(R, 7).Value
rs.Fields("Employer") = ActiveDocument.Cells(R, 9).Value
rs.Fields("Contact") = ActiveDocument.Cells(R, 10).Value
rs.Fields("OthEPhone") = ActiveDocument.Cells(R, 11).Value
rs.Fields("Action") = ActiveDocument.Cells(R, 12).Value
rs.Fields("Remarks") = ActiveDocument.Cells(R, 13).Value
Dim response As Variant
response = MsgBox("New Record Added to AdjLog Record")
rs.Update
End If
rs.Close
Set rs = Nothing
dbs.Close
Set dbs = Nothing

End Sub