Export Data to Access Table
 

Afternoon, 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. 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... Thanks

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

Export Data to Access Table
 

This might be a help for getting data to and from Excel and Access: It
includes examples of using variables in SQL queries.
http://www.bygsoftware.com/examples/sql.html

Or you can get there from the "Excel with Access Databases" section on page:
http://www.bygsoftware.com/examples/examples.htm

It demonstrates how to use SQL in Excel's VBA to:

* create a database,
* create a table and add data to it,
* select data from a table,
* delete a table,
* delete a database.

You can also download the demonstration file called "excelsql.zip".

The code is open and commented.


--

Regards
Andy Wiggins
www.BygSoftware.com
Home of "Save and BackUp",
"The Excel Auditor" and "Byg Tools for VBA"


"Pete T" wrote in message
om...
Afternoon, 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. 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... Thanks

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