0

Excel and database fileI tried the code in this link to push and retrieved the data between Excel and Access. I modified the code based on my file path as following:

EDITED NEW CODE BLOCK

Sub UpdateMDB()
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long

lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row

accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"

Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")

accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If

Do While Not accRST.EOF
For i = 1 To lastrow
    If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
            And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i) Then
       accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i)
    End If
Next i
accRST.Update
accRST.MoveNext
Loop

accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing

End Sub

INITIAL CODE BLOCK

Sub GetMDB()
Dim cn As Object
Dim rs As Object

strFile = "Z:\Documents\Database\Database1.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

strSQL = "SELECT * FROM Table1"
rs.Open strSQL, cn

With Worksheets(1)
For i = 0 To rs.Fields.Count - 1
    .Cells(1, i + 1) = rs.Fields(i).Name
Next

rs.MoveFirst
.Cells(2, 1).CopyFromRecordset rs
End With
End Sub

Sub UpdateMDB()
Dim cn As Object
Dim rs As Object

''It would probably be better to use the proper name, but this is
''convenient for notes
 strFile = Workbooks(1).FullName

''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns
 strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
 Set cn = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")
 cn.Open strCon

''Selecting the cell that are different
 strSQL = "SELECT * FROM [Sheet1$] s " _
& "INNER JOIN [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "ON s.id=t.id " _
& "WHERE s.Field1<>t.Field1"
rs.Open strSQL, cn, 1, 3 ''adOpenKeyset, adLockOptimistic

''Just to see
''If Not rs.EOF Then MsgBox rs.GetString

''Editing one by one (slow)
rs.MoveFirst
Do While Not rs.EOF
rs.Fields("t.Field1") = rs.Fields("s.Field1")
rs.Update
rs.MoveNext
Loop

''Batch update (faster)
strSQL = "UPDATE [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "INNER JOIN [Sheet1$] s " _
& "ON s.id=t.id " _
& "SET t.Field1=s.Field1 " _
& "WHERE s.Field1<>t.Field1 "

cn.Execute strSQL
End Sub

Reading data from Access to Excel GetMDB() macro works fine, But when I tried to update the data from Excel to Access, code gives me following error:

Run-time error '3021':
Either BOF or EOF is True, or the current record has been deleted. 
Requested operation requires a current record.

I checked the mdb, xlsx and sheet path and names are correct. Anyone got a similar problem as well and how to overcome? Thanks.

Erik A
  • 31,639
  • 12
  • 42
  • 67
ylcnky
  • 775
  • 1
  • 10
  • 26
  • Please include all your code specially the code you use to commit to Access. Sounds like you are trying to update from an empty recordset. – nbayly Oct 24 '16 at 15:19
  • Thanks for your reply, I edited the code that I used above. – ylcnky Oct 24 '16 at 20:50
  • Can you add before you loop through your `rs` to update one by one a `rs.MoveLast` and `MsgBox rs.RecordCount` to confirm that your recordset has entries in it. If it comes with entries than you can try `rs.Update(dbUpdateCurrentRecord)` to force the UpdateType. – nbayly Oct 24 '16 at 22:21

1 Answers1

0

You cannot run UPDATE queries using Excel workbook sources as any SQL queries using workbooks are read-only from last saved instance and cannot be updated. Excel simply is not a database to do such transactions with no record-level locking mechanism, read/write access, or relational model. Though you can run append (INSERT INTO ... SELECT *) and make-table queries (SELECT * INTO FROM ...), you cannot run UPDATE that aligns to live values.

However, you can read in an Access recordset and iterate through the Excel cells aligning by ID matches. Below assumes the Excel Sheet's ID column is in Column A and Field1 is in Column B.

Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
Const adOpenKeyset = 1, adLockOptimistic = 3, adCmdTableDirect = 512

lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row

accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"

Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")

accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
    accRST.MoveFirst
Else
    Msgbox "No records in Access table.", vbInformation
    accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
    Exit Sub
End If

Do While Not accRST.EOF
    For i = 1 to lastrow
        If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
                And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i)  Then 
           accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i) 
        End If
    Next i
    accRST.Update
    accRST.MoveNext
Loop 

accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing

Notes:

  1. If IDs between Excel worksheet and Access table are not one-to-one (i.e., Excel has multiple rows of same ID), the last Field1 value following the If logic will be inserted to corresponding Access row.

  2. Above may be extensive processing if database rows and Excel cells are large. The best option is simply to use Access for all data entry/management and avoid the update needs. Since Excel is a flatfile, consider using it as the end use application and Access as central data repository.

Parfait
  • 104,375
  • 17
  • 94
  • 125
  • Thanks, I added your code tothe second part instead of UpdateMDB and it is shown in my first comment "EDITED NEW CODE BLOCK". But it gives error `Runtime error 3001 Arguments are of the wrong type or out of acceptable range, or are in conflict with one another`. Just in case of changing sth in the code, my excel file name is `book1.xlsm` and `sheet1`. The error debug shows the line `accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect` – ylcnky Oct 25 '16 at 11:36
  • Whoops! Since we late binded the ADO objects, I forgot to declare the constants. Add this towards top: `Const adOpenKeyset = 1, adLockOptimistic = 3, adCmdTableDirect = 512`. See edit. If that does not work, is *Field1* a date field? – Parfait Oct 25 '16 at 19:33
  • Thanks for the reply, now it works well. I accepted you answer. May I ask how you chose these constants? And I have another question also. Now I have some columns and "Date and time" in _Field1_ (Column B). I change a value in one column (F) in excel and save it, and when run the _UpdateMDB_, it does not give any error, but does not update the database file. Is it different when we have date in _Field1_? What about if I have some empty cells in excel, and I want to receive error after Update that these cells are empty? – ylcnky Oct 26 '16 at 13:02
  • You can find constants on the doc pages: [CursorTypeEnum](https://msdn.microsoft.com/en-us/library/ms681771(v=vs.85).aspx), [LockTypeEnum](https://msdn.microsoft.com/en-us/library/ms680855(v=vs.85).aspx), [CommandTypeEnum](https://msdn.microsoft.com/en-us/library/ms675946(v=vs.85).aspx). For dates, wrap Excel value in `CDate()`: `CDate(Workbooks(1).Sheets(1).Range("C" & i).Value)` and be sure to check `If` logic. – Parfait Oct 26 '16 at 21:02
  • Thanks for documents. I am not sure where exactly to add this line, but to make it more clear I have attached an image including my excel and database files to my first post. I change one cell in (e.g. column _F2_) in excel and it doesn't not update in database file. When I add the line `CDate() : ...` also it gives `Expected: Identifier`error before compiling. Do I need to add an expression to `CDate()`? May I ask where I need to add the _CDate_ function? – ylcnky Oct 27 '16 at 13:23
  • I show exactly where to add the function. Wrap it around your Excel cell value in VBA code (specifically inside `For` loop). Also, dot separators cannot be used for dates, so you may have to replace with forward slash before conversion to datetime: `CDate(Replace(Field1, ",", "/"))`. – Parfait Oct 27 '16 at 16:05
  • Thanks, I changed the loop for update to update _Field1_ _FI_ in access file after changing the column _F_ in excel. Here is the change: `And accRST!FI <> Workbooks(1).Sheets(1).Range("F" & i) Then accRST!FI.Value = Workbooks(1).Sheets(1).Range("F" & i)`. Now I want to do make a query in excel to show a range of cells e.g. (_ID_ 1 to 30), but I want it gives me an error also that which cells are blank. Could you please let me know how I can do that? – ylcnky Nov 01 '16 at 21:36
  • Consider asking a new question as *query in excel* strays from original post. – Parfait Nov 01 '16 at 21:48
  • I asked it in new post. But may I ask about the change in the code that I wrote in the previous comment, what if I want to have it for all Fields and columns? I mean instead of changing column _F_ and updating Field _FI_, it happens for all columns in my excel file. I need to update every cell that I change its cell in every columns form _D_ to _L_. – ylcnky Nov 01 '16 at 22:15