Update an Access record using VBA in Excel

[AndrewKent]

Hi there,



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

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...

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

 

[BrianB]

Here is a way of doing the job :-

'=============================================================================
'- 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
'-----------------------------------------------------------------------------

 

[dbrakebill]

Andrew, you're missing ".UPDATE" after you set all of the fields.

 

[z06vetteguy]

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?

 

[BrianB]

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 ...........

    '-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

 

[z06vetteguy]

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 & "'"

 

[BrianB]

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.