Refreshing Access table using VBA

[Pookiemeister]

Is there a way to refresh my table in MS Access through an Excel userform button? After I insert data into the table I want it to requery or "RefreshAll" in the table. Is there a way to do this? Here is what I have so far. Thank you.

Private Sub btnEnter_Click()
    Me.lblRcrdAdded = Now()
    Call ConnectDB_Insert
    Unload Me
End Sub

Sub ConnectDB_Insert()
    On Error GoTo ErrorHandler
    
    ' Path
    Dim strPath As String
    ' Provider
    Dim strProv As String
    ' Connection String
    Dim strConn As String
    ' Connection
    Dim Conn As New ADODB.connection
    ' SQL Query
    Dim strQry As String
    
    strPath = "C:\Users\User\OneDrive\Documents\Personnel.accdb"
    strProv = "Microsoft.ACE.OLEDB.12.0;"
    strConn = "Provider=" & strProv & ";Data Source=" & strPath
    
    ' Connection Open
    Debug.Print "Opening connection..."
    Conn.Open strConn
    Debug.Print "Connection opened."
    
    ' SQL Query with parameters
    strQry = "INSERT INTO Personnel ([Employee #], [Network ID], [First Name], [Last Name], [Email Address], [Phone], [Record Added]) " & _
             "VALUES (me.txtempnum.text,me.txtntwrkid.text , me.txtfn.text, me.txtln.text, me.txtemail.text, me.txtphone.text, me.lblrcrdadded.caption)"
    
    ' Create a command object
    Dim cmd As New ADODB.Command
    With cmd
        .ActiveConnection = Conn
        .CommandText = strQry
        .CommandType = adCmdText
        ' Add parameters
        .Parameters.Append .CreateParameter("EmployeeNum", adVarChar, adParamInput, 255, frmPersonnelEntry.txtEmpNum.Text)
        .Parameters.Append .CreateParameter("NetworkID", adVarChar, adParamInput, 255, frmPersonnelEntry.txtNtwrkID.Text)
        .Parameters.Append .CreateParameter("FirstName", adVarChar, adParamInput, 255, frmPersonnelEntry.txtFN.Text)
        .Parameters.Append .CreateParameter("LastName", adVarChar, adParamInput, 255, frmPersonnelEntry.txtLN.Text)
        .Parameters.Append .CreateParameter("EmailAddress", adVarChar, adParamInput, 255, frmPersonnelEntry.txtEmail.Text)
        .Parameters.Append .CreateParameter("Phone", adVarChar, adParamInput, 255, frmPersonnelEntry.txtPhone.Text)
        .Parameters.Append .CreateParameter("RecordAdded", adVarChar, adParamInput, 255, frmPersonnelEntry.lblRcrdAdded.Caption)
    End With
    
    ' Execute the command
    Debug.Print "Executing command..."
    cmd.Execute
    Debug.Print "Command executed."
    
    ' Refresh the form
    'frmPersonnelEntry.Requery
    
    ' Close the connection
    Conn.Close
    Set Conn = Nothing
    Set cmd = Nothing
    
    ' SQL Query to refresh the table
    Call RefreshAccessTable
      
    Exit Sub
    
ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
    If Not Conn Is Nothing Then
        Conn.Close
        Set Conn = Nothing
    End If
    Set cmd = Nothing
End Sub

Sub RefreshAccessTable()
       
    On Error Resume Next
    
      'Path
    Dim strPath As String
   
    'Provider
    Dim strProv As String
   
    'Connection String
    Dim strConn As String
   
    'Connection
    Dim Conn As New ADODB.connection
   
    'SQL Query
    Dim strFrmQryEID As String
    
    'RecordSet
    Dim rs As New ADODB.Recordset
    
    strPath = "C:\Users\User\OneDrive\Documents\Personnel.accdb"
    strProv = "Microsoft.ACE.OLEDB.12.0;"
    strConn = "Provider=" & strProv & "Data Source=" & strPath
    
    Conn.Open strConn
          
    ' Debug: Print the SQL query
    Debug.Print "SQL Query: " & strFrmQryEID
    
    rs.Open strFrmQryEID, Conn
    rs.Requery
    
    rs.Close
    Conn.Close
    
    ' Notify user
    MsgBox "All linked tables have been refreshed.", vbInformation
    
End Sub

 

[bobsan42]

I think you are confusing the things a bit.
Once you add the data the table has it already - there is no need to refresh it.
If you want to take the data from it and show it again in excel this is a bit different.
And you have done it halfway, afaics.

rs.Open strFrmQryEID, Conn

I don't know what is the actual query, but in this way you have created a recordset which contains the results returned by the query.
Unless you expect a change between getting the data and using it - you do not need rs.Requery
I you want to place this in excel - you can do it in several ways. Below is an example I wrote some time ago:

Sub RecordsetToRange(ByVal rs As ADODB.Recordset, rdest As Variant, _
                    Optional AddHeaders As Boolean = True, _
                    Optional NoMessage As Boolean = False, _
                    Optional ResizeTable As Boolean = True)
    Dim tbn As String, rD As Range, lo As ListObject
    Dim xa, xb, vt, vval, rc As Long, fc As Long, txt As String, tCols As Long
    vt = VBA.Timer
    
    On Error Resume Next
    Select Case LCase(TypeName(rdest))
        Case "range": Set rD = rdest: txt = rdest.Address(0, 0, , True): rdest.Parent.ShowAllData
        Case "listobject": Set lo = rdest: txt = lo.Name: tCols = lo.ListColumns.Count: lo.AutoFilter.ShowAllData
        Case Else: GoTo EP
    End Select
    
    If rs Is Nothing Then
        If Not NoMessage Then MsgBox "No Recordset returned.", vbCritical
        GoTo EP
    End If
    
    With rs
        xa = RecordsetFieldsToArray(rs)
        .MoveFirst
        xb = .GetRows
        If IsArray(xb) Then rc = UBound(xb, 2) - LBound(xb, 2) + 1
        fc = .Fields.Count
        .MoveFirst
    End With
    
    On Error Resume Next
    If Not lo Is Nothing Then
        With lo
            If .ListRows.Count > 0 Then
                .DataBodyRange.ClearComments
                .DataBodyRange.Delete
            End If
            If fc > 0 Then
                If AddHeaders Then .HeaderRowRange.ClearContents
                If ResizeTable Then .Resize .HeaderRowRange.Cells(1, 1).Resize(2, fc)
                If AddHeaders Then .HeaderRowRange.Value = xa
            End If
            If rc > 0 Then
                .ListRows.Add
                .DataBodyRange.Cells(1, 1).Offset(1).Resize(rc - 1, fc).Insert (xlDown)
                .DataBodyRange.CopyFromRecordset rs
            End If
            fc = .ListColumns.Count
            If tCols > fc Then _
                .HeaderRowRange.Resize(1, 1).Offset(0, fc).Resize(1, (tCols - fc)).ClearContents
        End With
    End If
    
    If Not rD Is Nothing Then
        With rD
            Set rD = .Resize(1, 1)
            If AddHeaders Then _
                If IsArray(xa) Then .Resize(UBound(xa, 1) + 1, UBound(xa, 2) + 1).Value = xa
            If IsArray(xb) Then
                If AddHeaders Then
                    .Offset(UBound(xa, 1) + 1).CopyFromRecordset rs
                Else
                    .CopyFromRecordset rs
                End If
            End If
            Set rs = Nothing
        End With
    End If

EP:
On Error Resume Next
    Set rs = Nothing
    vval = Null
    xa = Null
    Set lo = Nothing
    Set rD = Nothing
End Sub

Function RecordsetFieldsToArray(ByVal rs As ADODB.Recordset)
    If rs Is Nothing Then Exit Function
    Dim xa(), i As Long
    With rs
        ReDim xa(0 To 0, 0 To .Fields.Count - 1)
        For i = 0 To .Fields.Count - 1
            xa(0, i) = .Fields(i).Name
        Next i
    End With
    RecordsetFieldsToArray = xa
EP:
    On Error Resume Next
    Erase xa
    Set rs = Nothing
End Function

 

[Micron]

Agree. The only thing you'd have to refresh with respect to a table (or query for that matter) is the current datasheet view. In other words, if you're looking at the datasheet view and you do something to modify the underlying data (e.g. run a query) then you'd need to refresh the current view, or close it and reopen it. As long as the table record is not still being edited when you attempt to access table data, then the new record is there for your use.