Access To Excel and Excel to Access to VBA

Access to Excel Data Retrieving :


'SearchButton
Private Sub CommandButton1_Click()
On Error GoTo Err:

Application.StatusBar = "Connecting...."
Dim sh As Worksheet
Dim cn As ADODB.Connection, rs As New ADODB.Recordset, r As Long
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=\\192.168.1.159\D\ReceiptDataBase.accdb;"
   
    rs.Open "Sheet1", cn, adOpenStatic, adLockOptimistic, adCmdTable
Set sh = Sheets("InterFace")

c = 0
While Not rs.EOF = True
        If rs.Fields("IndusID") = sh.Range("InID").Value And IsNull(rs.Fields("PaidAt").Value) Then
       
        rw = sh.Range("A100").End(xlUp).Row + 1
            For Each f In rs.Fields
            sh.Cells(rw, c + 1).Value = rs.Fields(c).Value
            c = c + 1
            Next
           
        End If
        rs.MoveNext
 Wend
 Set cn = Nothing
 Set rs = Nothing
Exit Sub
Err:
If Err.Number > 0 Then
    MsgBox "Connection Error", vbInformation
    End If

End Sub


Update Query From Excel To Access

' Updated Button
Private Sub Upldate_Click()

On Error GoTo Err:

Application.StatusBar = "Connecting...."
Dim sh As Worksheet
Dim Rng As Range
Dim cell As Range
Dim Sql As String
Dim cn As ADODB.Connection, rs As New ADODB.Recordset, r As Long
    Set cn = New ADODB.Connection
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
    "Data Source=\\192.168.1.159\D\ReceiptDataBase.accdb;"
Set sh = Sheets("interFace")
Set Rng = sh.Range("J5:J" & Range("A100").End(xlUp).Row)
        If Rng.Row = 4 Then Exit Sub

    For Each cell In Rng
    If cell.Value <> "" Then
    Sql = "Update  Sheet1 Set PaidAt=" & Range("I" & cell.Row).Value & ",PaidDate='" & Range("J" & cell.Row).Value & "',ReceiptNumber=" & Range("K" & cell.Row).Value & ", Remark =' " & Range("L" & cell.Row) & "' where EneryUsageID =" & Range("B" & cell.Row)
    cn.Execute Sql, "Sheet1"
    Rows(cell.Row).Delete
    MsgBox "Updated"
    End If
    Next

 Set cn = Nothing
 Set rs = Nothing
Exit Sub
Err:
End Sub