(Solved) – Updating records in Access table using excel VBA

(solved)-–-updating-records-in-access-table-using-excel-vba

I’m trying to create a script to update the existing records in Access Table using the excel value and unique ID. So far, I have the below Sub for Update

Sub Update_Data()

Dim dbPath As String
Dim lastRow As Long
Dim UpdatedRowCnt As Long
Dim NotFoundRowCnt As Long

'add error handling
On Error GoTo exitSub

'Check for data

If Worksheets("Update").Range("A2").Value = "" Then
MsgBox "Add the data that you want to send to MS Access"
    Exit Sub
End If

'Variables for file path
dbPath = Worksheets("Export").Range("K3").Value '"W:Edward_ConnectionDatabase.accdb"

'Check file path exists
If Not FileExists(dbPath) Then
    MsgBox "The Database file doesn't exist! Kindly correct first"
        Exit Sub
End If

'find las last row of data, can we have the last row point to exact worksheet Worksheets("Update")?
lastRow = Cells(Rows.Count, 1).End(xlUp).Row


Dim cnx As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class


On Error GoTo errHandler

'Initialise the collection class variable
Set cnx = New ADODB.Connection

'Connection class is equipped with a —method— named Open
'—-4 aguments—- ConnectionString, UserID, Password, Options
'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
cnx.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'OLE stands for Object Linking and Embedding, Database

'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset

Dim qry As String
qry = "SELECT * FROM  PhoneList WHERE ID = " 'Don't know how to pass this query in the line of script and loop to next row available

'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="PhoneList", ActiveConnection:=cnx, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable

'Continue reading Database now
'you now have the recordset object
'add the values to it

'Wait Cursor
Application.Cursor = xlWait

'Pause Screen Update
Application.ScreenUpdating = False

'Set  UpdatedRowCnt and NotFoundRowCnt to 0 first
UpdatedRowCnt = 0
NotFoundRowCnt = 0
    'Suppose Data is on Column B to C.
    '    --> So let's put the "Not Found in DB" on Column D
For nRow = 2 To lastRow
    'Check if the Row has already been updated?
    'If it it isn't then continue
    If IdExists(cnx, Range("A" & nRow).Value) = True Then 'I declared True since the default value is set to False in the Function
        'Item already exported, so update the Status
        Range("D" & nRow).Value2 = "Not Found in DB"
        NotFoundRowCnt = NotFoundRowCnt   1
    Else
        rst.AddNew  'Update RecordSet '

            'Itirating Columns on on Column B to C
            For nCol = 2 To 3
                rst.Fields(Cells(1, nCol).Value2) = Cells(nRow, nCol).Value 'Using the Excel Sheet Column Heading
            Next nCol

        rst.Update  'Update RecordSet

        'Update the Status on Column D when the record is successfully updated
        Range("D" & nRow).Value2 = "Updated"

        'Increment exportedRowCnt
        UpdatedRowCnt = UpdatedRowCnt   1
    End If
Next nRow

'close the recordset
rst.Close

' Close the connection
cnx.Close
'clear memory
Set rst = Nothing
Set cnx = Nothing

If UpdatedRowCnt > 0 Or NotFoundRowCnt > 0 Then
    'communicate with the user
    MsgBox UpdatedRowCnt & " Drawing(s) Updated " & vbCrLf & _
      NotFoundRowCnt & " Drawing(s) Not Found in DB"

End If

'Update the sheet
Application.ScreenUpdating = True
exitSub:
'Restore Default Cursor
Application.Cursor = xlDefault

'Update the sheet
Application.ScreenUpdating = True
    Exit Sub

errHandler:
'clear memory
Set rst = Nothing
Set cnx = Nothing
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data_Updated"

Resume exitSub
End Sub

Function to Check if the ID Exists

Function IdExists(cnx As ADODB.Connection, sId As String) As Boolean

'Set IdExists as False and change to true if the ID exists already
IdExists = False

'Change the Error handler now
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim cmd As ADODB.Command   'dim the ADO command class

On Error GoTo errHandler

'Sql For search
Dim sSql As String
sSql = "SELECT Count(PhoneList.ID) AS IDCnt FROM PhoneList WHERE (PhoneList.ID='" & sId & "')"

'Execute command and collect it into a Recordset
Set cmd = New ADODB.Command
cmd.ActiveConnection = cnx
cmd.CommandText = sSql

'ADO library is equipped with a class named Recordset
Set rst = cmd.Execute 'New ADODB.Recordset 'assign memory to the recordset

'Read First RST
rst.MoveFirst

'If rst returns a value then ID already exists
If rst.Fields(0) > 0 Then
    IdExists = True
End If

'close the recordset
rst.Close

'clear memory
Set rst = Nothing
exitFunction:
    Exit Function

errHandler:
'clear memory
Set rst = Nothing
    MsgBox "Error " & Err.Number & " :" & Err.Description
End Function

Any help is very much appreciated.

Leave a Reply

Your email address will not be published. Required fields are marked *