Update an Access record using VBA in Excel

AndrewKent

AndrewKent

Well-known Member
Joined
Jul 26, 2006
Messages
889
Hi there,



I am trying to update a record in an Access database from Excel, I have two macros running to do this...



Code: 
Sub UpdateRecord()

'   =============================================================================================
'   This macro will firstly connect to the Access database. It will then update every field in
'   each table based on the criteria that has been set. In order to simplify the code structure,
'   the coding to update each table has been placed in individual macros.
'   =============================================================================================

    StartTimer ' This code is required for testing purposes only

    Dim DBName, DBLocation, FilePath As String
    Dim DBConnection As ADODB.Connection
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set DBConnection = New ADODB.Connection
    DBName = Worksheets("Calculation Matrix").Range("CalculationMatrix_DatabaseName").Value
    DBLocation = Worksheets("Calculation Matrix").Range("CalculationMatrix_DatabaseLocation").Value
    FilePath = DBLocation & DBName

    With DBConnection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open FilePath
    End With
    
    Call UpdateIndex(DBConnection)
'    Call UpdateCustomerData(DBConnection)
'    Call UpdateCPIData(DBConnection)

    DBConnection.Close
    Set DBConnection = Nothing
    
    Worksheets("Index").Activate
    Range("A1").Select
    
    EndTimer ' This code is required for testing purposes only

End Sub



and...



Code: 
Sub UpdateIndex(DBConnection As ADODB.Connection)

'   =============================================================================================
'   This macro is responsible for updating one table within the database. It is called by the
'   UpdateRecord macro as part of a routine.
'   =============================================================================================

    Dim DBRecordset As ADODB.Recordset
    Dim Query As String
    
    Query = "SELECT * FROM tblIndex WHERE Record_ID =" & Worksheets("Calculation Matrix").Range("CalculationMatrix_Search").Value

    Set DBRecordset = New ADODB.Recordset
    DBRecordset.CursorLocation = adUseServer
    DBRecordset.Open Source:=Query, ActiveConnection:=DBConnection, CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, Options:=adCmdText

    With DBRecordset
        .Fields("Record_ID") = Worksheets("Data Capture").Range("C5").Value
        .Fields("Created_By") = Worksheets("Data Capture").Range("C6").Value
        .Fields("Created_Date") = Worksheets("Data Capture").Range("C7").Value
        .Fields("Modified_By") = Worksheets("Data Capture").Range("C8").Value
        .Fields("Modified_Date") = Worksheets("Data Capture").Range("C9").Value
        .Fields("Stakeholder_ID") = Worksheets("Data Capture").Range("C10").Value
    End With

    DBRecordset.Close
    Set DBRecordset = Nothing

End Sub



...however I'm getting the message "Operation is not allowed in this context" on the DBRecordset.Close line.



Anyone know why?



Andy
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Sort by date Sort by votes
Here is a way of doing the job :-
Code: 
'=============================================================================
'- UPDATE AN ACCESS RECORD FROM EXCEL
'- FIND SPECIFIED RECORD IN AN ACCESS TABLE FROM EXCEL
'=============================================================================
'- EXCEL  : GETS LOOKUP VALUE FROM ROW CONTAINING SELECTED CELL COLUMN A
'- ACCESS : CHECKS CORRECT RECORD FOUND
'- ACCESS : REPLACES RECORD VALUES WITH EXCEL WORKSHEET VALUES
'- We save code by "changing" field values even if they are the same.
'- Brian Baulsom November 2008
'=============================================================================
Dim ws As Worksheet
Dim FromRow As Long
Dim FromCol As Integer
Dim MyColumnCount As Integer
Dim MyPath As String
Dim db As Database
Dim MyTable As Recordset
Dim MyLookupValue As String
Dim MyMsg As String
Dim MsgLine1 As String
Dim rsp
'=============================================================================
'- MAIN ROUTINE
'=============================================================================
Sub UPDATE_RECORD()
    '-------------------------------------------------------------------------
    '- ASSUMES ACCESS .MDB IS IN THE SAME FOLDER AS THIS WORKBOOK
    MyPath = ThisWorkbook.Path & "\"
    ChDrive MyPath
    ChDir MyPath
    '-------------------------------------------------------------------------
    '- EXCEL : GET LOOKUP VALUE & NUMBER OF COLUMNS
    Set ws = ActiveSheet
    With ws
        FromRow = ActiveCell.Row
        MyColumnCount = .Cells(FromRow, .Columns.Count).End(xlToLeft).Column
        MyLookupValue = .Cells(FromRow, "A").Value
    End With
    '-------------------------------------------------------------------------
    '- ACCESS : SET RECORDSET = TABLE
    Set db = DBEngine(0).OpenDatabase(MyPath & "test.mdb")
    Set MyTable = db.OpenRecordset("TestTable1", dbOpenDynaset)
    With MyTable
        '---------------------------------------------------------------------
        '- DO LOOKUP. HERE USES FIELD CALLED "Field1"
        .FindFirst "Field1='" & MyLookupValue & "'"
        '---------------------------------------------------------------------
        '- CHECK IF MATCH FOUND
        If .NoMatch Then
            MsgBox (MyLookupValue & " not found.")
            GoTo GetOut
        Else
            '------------------------------------------------------------------
            '- MESSAGE TO CHECK CURRENT RECORD
            MsgLine1 = "FOUND RECORD CONTENTS BELOW.     OK to change ?"
            GetMessage          ' SUBROUTINE
           rsp = MsgBox(MyMsg, vbOKCancel, "  FOUND RECORD")
           If rsp = vbCancel Then GoTo GetOut
            '------------------------------------------------------------------
            '- UPDATE ACCESS RECORD
            .Edit
            For FromCol = 1 To MyColumnCount
                .Fields(FromCol - 1).Value = ws.Cells(FromRow, FromCol).Value
            Next
            .Update
            '------------------------------------------------------------------
        End If
    End With
    '--------------------------------------------------------------------------
    '- CONFIRMATION MESSAGE
    MsgLine1 = "CONFIRM CHANGE"
    GetMessage          ' SUBROUTINE
    rsp = MsgBox(MyMsg, vbOKOnly, " CURRENT POSITION")
    '--------------------------------------------------------------------------
GetOut:
    MyTable.Close
    db.Close
    Set MyTable = Nothing
    Set db = Nothing
End Sub
'=============================================================================
'- SUBROUTINE TO SET UP MESSAGE
'- aligns XL values using spaces (not an exact science)
'=============================================================================
Private Sub GetMessage()
    Dim XLval As Variant
    Dim ACval As Variant
    Dim XLalignment As Integer  ' MESSAGE ALIGN XL COLUMN WITH SPACES
    XLalignment = 30
    '-------------------------------------------------------------------------
    With MyTable
        MyMsg = MsgLine1 & vbCr & vbCr _
        & "ACCESSS" & Space(XLalignment) & "EXCEL" & vbCr & vbCr
        '---------------------------------------------------------------------
        '-  CHECK COLUMNS
        For FromCol = 1 To MyColumnCount
            XLval = ws.Cells(FromRow, FromCol)
            ACval = .Fields(FromCol - 1).Value
            MyMsg = MyMsg _
                & .Fields(FromCol - 1).Name & " : " & ACval _
                & Space(XLalignment - Len(CStr(ACval))) _
                & IIf(XLval = ACval, "      =  ", "---->> *") & XLval & vbCr
        Next
    End With
End Sub
'-----------------------------------------------------------------------------
 
Upvote 0
I have a very similar question. so I'm using this old thread.

I want to look for a record in an Access database then if it does not exist, add a new record. If the record does exist, send a message to the user.

I'm using Excel and Access 2000.

Is the BrianB method from above valid in Excel 2000, and if so, what references must I add in order for this to work?

Are there other methods that are valid in Excel 2000?
 
Upvote 0
My code was set up in XL2000 but should also work in 2003 and 2010.

It contains all the basics you need. Something like this ...........

Code: 
    '-NB.  PARTIAL CODE - UNTESTED
    With MyTable
        '---------------------------------------------------------------------
        '- DO LOOKUP. HERE USES FIELD CALLED "Field1"
        .FindFirst "Field1='" & MyLookupValue & "'"
        '---------------------------------------------------------------------
        '- CHECK IF MATCH FOUND
        If .NoMatch Then
            '- ADD A NEW RECORD
            .Edit
            .AddNew
            '------------------------------------------------------------------
            '- UPDATE ACCESS RECORD
            For FromCol = 1 To MyColumnCount
                .Fields(FromCol - 1).Value = ws.Cells(FromRow, FromCol).Value
            Next
            .Update
            '------------------------------------------------------------------
        Else
            MsgBox ("Record exists.")
            Exit Sub
        End If
    End With
 
Upvote 0
Thank you very much.

I still get a complie error "Method or data member not found" on this line:


.FindFirst "Applied Product Part Number='" & MyLookupValue & "'"
 
Last edited:
Upvote 0
Perhaps you have not added tools/reference/ DAO ... whatever.
perhaps you need to put ' marks around 'Applied Product Part Number'
Access does not like spaces.
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
Run-time error '-2147217900 (80040e14)': Syntax error or access violation
Replies
0
Views
120
kristianb63
K
T
  • Question Question
Using SQL to extract results
Replies
2
Views
279
tiredofit
T
L
  • Solved
Trouble running an access query in excel vba
Replies
2
Views
189
Legal Tender
L
T
  • Question Question
Printing to PDF use VBA - Was working but now different sheets are different widths
Replies
1
Views
268
Tanquen
T
D
  • Question Question
VBA Code to Apply an AVERAGE of a Range on Cells as New Records are added Via a User Form
Replies
2
Views
88
Denny57
D

Forum statistics

Threads
1,224,521
Messages
6,179,282
Members
452,902
Latest member
Knuddeluff

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top