Code to Refresh Link to SharePoint Lists (1 Viewer)

'***********Code Start****************
'This code is a modified version of the code that can be found at:
'http://blogs.office.com/b/microsoft-access/archive/2009/02/04/code-to-refresh-sharepoint-link-tables.aspx
'The original code has been modified by Byron Polk
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
Public Function RefreshSharePointLinks()
Dim rst As DAO.Recordset
Dim tbl As DAO.TableDef
Dim fld As DAO.Field
Dim strSql As String
On Error GoTo Err_ChkError
'iterate through all of the table objects in the database
For Each tbl In CurrentDb.TableDefs
    'only try to refresh linked or "Attadhed" tables
    If (Mid(tbl.Name, 1, 1) <> "~") And ((tbl.Attributes And dbAttachedTable) = dbAttachedTable) Then
        '***You may need to add additional "If" statements to have the code
        '   ignore specific tabale
        'if the table is named "User Information List" do not relink the table
        If Left(tbl.Name, 21) <> "User Information List" Then
            'if the table is named "UserInfo" do not relink the table
            If Left(tbl.Name, 8) <> "UserInfo" Then
                'if the connection string for the linked or "Attached" table
                'starts with "WSS" then this is a ShasrPoint table.
                If Left(tbl.Connect, 3) = "WSS" Then
                    'try to open an editabel recordset from this table
                    strSql = "SELECT * FROM [" & tbl.Name & "];"
                    Set rst = CurrentDb.OpenRecordset(strSql, dbOpenDynaset)
                    'locate an updatable field (not a calculated column)
                    For Each fld In tbl.Fields
                        If fld.Type = dbText Then
                            'if there is a value in this field use this field
                            If Not IsNull(rst.Fields(fld.Name).Value) Then
                                'insure that this field is an updateable type field
                                If fld.DataUpdatable = False Then
                                    'set the recordset to "edit" mode
                                    rst.Edit
                                    'update the updatabale field with the same value
                                    rst.Fields(fld.Name).Value = rst.Fields(fld.Name).Value
                                    'attempt to update the record.
                                    rst.Update
                                    'if the table needs to be relinked, error 3851 will occur and
                                    'our "On Error" error handling will kick in and relink the table
                                    'Only if the update was successful, move on to the next linked table
                                    GoTo GetNextLinkedTbl
                                End If
                            End If
                        End If
                    Next
                End If
            End If
        End If
    End If
GetNextLinkedTbl:
Next
Exit_RefreshLinks:
    Exit Function
Err_ChkError:
    Debug.Print Err.Number & ", " & Err.Description
    rst.Close
    Set rst = Nothing
    'if the schema of the linked table has changed
    If Err.Number = 3851 Then
        'set the linked table to update the link
        DoCmd.SelectObject acTable, tbl.Name, True
        'refresh the link
        DoCmd.RunCommand acCmdRefreshSharePointList
        'when the link to this table has be refreshed, move on to check other tables
        GoTo GetNextLinkedTbl
    'Else    'some other error occurred so display the error and exit the funciton
    '    MsgBox "Error: " & Err.Number & ", " & Err.Description
    '    GoTo Exit_RefreshLinks
    End If
    
End Function