Updating Access Database with Excel File

[jmelinda]

Hello,

I've been trying to make this work for hours and hours and am finally giving up. Most of this code was found on the internet and I've attempted to make it work for my project but I keep getting errors. I use VBA with Excel quite often but never with Access before. Currently I am getting an "Object doesn't support this property or method" error at rs.Findfirst.

I have an excel worksheet that mimics the access table with five fields, an ID field, lastName, FirstName, DeptID (int), Email. I want to search the Access table for a match on the email field, and if it doesn't find the match, to add a new record using values typed into the excel sheet.

Sub UpdateDB()
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL As String
Dim CurrentRow As Integer

strCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source=S:\HousingServices\Managers\DB\Julie\Access\Access Data Import Template.xlsm" & _
        ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
        
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM [Staff$] s " _
    & "INNER JOIN [;Database=S:\Access\Network Access Copy.accdb;].Staff t " _
    & "ON s.Email=t.Email " 

rs.Open strSQL, cn, 1, 3 

CurrentRow = 1

While ActiveWorkbook.Sheets("Staff").Range("B" & CurrentRow).Value <> ""
    If rs.RecordCount <> 0 Then
         Do While Not rs.EOF
            rs.MoveFirst
      [B]     [COLOR=#ff0000] rs.FindFirst "Email" = ActiveWorkbook.Sheets("Staff").Range("E" & CurrentRow).Value[/COLOR][/B]  - error is here
                If rs.NoMatch Then
                  rs.AddNew
                    rs.Fields("LastName") = ActiveWorkbook.Sheets("Staff").Range("B" & CurrentRow).Value
                    rs.Fields("FirstName") = ActiveWorkbook.Sheets("Staff").Range("C" & CurrentRow).Value
                    rs.Fields("Department") = ActiveWorkbook.Sheets("Staff").Range("D" & CurrentRow).Value
                    rs.Fields("Email") = ActiveWorkbook.Sheets("Staff").Range("E" & CurrentRow).Value
                  rs.Update
                End If
            CurrentRow = CurrentRow + 1
       Loop
    End If
Wend

rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing


End Sub

Any help would be greatly appreciated! I should also point that the Email field in Access has some null values. I think that could probably lead to some errors but haven't figured out how to account for that yet either.

 

[Rijnsent]

Hi Julie (guessing here),

as far as I can see you're using the ADO connection and not a DAO. There are some differences and this page ( Examples of DAO and ADO Recordsets (Poynor - MIS 333k) ) seems to show that the ADO recordset doesn't have a FindFirst property, only a .Find property. The DAO does have the .FindFirst property... Hope that pointer gets you moving, otherwise you'd change to the "rs.Filter="Email='" &ActiveWorkbook.Sheets("Staff").Range("E" & CurrentRow).Value & "'" option, where you'd then have to count how many records your rs then holds and remove the filter afterwards.

G'luck,

Koen

 

[jmelinda]

Oh ok, that makes sense since I was copying code from a few sources. Thanks for the point in the right direction!