Automate Refresh of Linked Tables (from SP)

[diofree]

I have some tables in an Access database linked to SharePoint.
Is there a way to automate having to right click on each table and refreshing the data?

Thanks!

 

[Frothingslosh]

Yep. Cycle through the tables, and if they have a connection string, rebuild it.

Public Function RelinkTables() As Boolean
[COLOR="SeaGreen"]' ************************************************************
' Created by       : Scott L Prince
' Parameters       : None
' Result           : None
' Date             : 1-2-14
' Remarks          :
' Changes          :
' ************************************************************[/COLOR]

Dim db As DAO.Database                      [COLOR="seagreen"]'Current database[/COLOR]
Dim tdf As DAO.TableDef                     [COLOR="seagreen"]'Used to refer to each table in the current database[/COLOR]
Dim ProcedureName As String                 [COLOR="seagreen"]'Name of the current procedure[/COLOR]
Dim Connection As String                    [COLOR="seagreen"]'Connection string[/COLOR]
Dim BackEnd As String                       [COLOR="seagreen"]'Back end name[/COLOR]
Dim BackendPath As String                   [COLOR="seagreen"]'Path to the back end[/COLOR]
Dim Msg As String                           [COLOR="seagreen"]'Message string[/COLOR]
Dim NumberOfTables As Long                  [COLOR="seagreen"]'Number of tables in the TableDefs collection[/COLOR]
Dim LoopCounter As Long                     [COLOR="seagreen"]'Loop counter[/COLOR]

    'Defaults[COLOR="seagreen"]
    [/COLOR]ProcedureName = "RelinkTables"
    Set db = CurrentDb
    RelinkTables = True
    NumberOfTables = db.TableDefs.Count
    LoopCounter = 1
    
    [COLOR="seagreen"]'Create a progress meter.[/COLOR]
    SysCmd acSysCmdInitMeter, "Refreshing links...", NumberOfTables
    
    [COLOR="seagreen"]'Cycle through every table in the current database.[/COLOR]
    For Each tdf In db.TableDefs
    
        [COLOR="seagreen"]'Update the progress meter.[/COLOR]
        SysCmd acSysCmdUpdateMeter, LoopCounter
        
       [COLOR="seagreen"] 'Determine if there is a connection string.[/COLOR]
        If Left$(tdf.Connect, 10) = ";DATABASE=" Then
        
           [COLOR="seagreen"] 'Assign the value of the connection string to Connection[/COLOR]
            Connection = Nz(tdf.Connect, "")
            
          [COLOR="seagreen"]  'Determine the path of the back-end.[/COLOR]
            BackendPath = GetFolder(Right(Connection, Len(Connection) - 10), False)
            
[COLOR="seagreen"]            'Pull the name of the back-end database.[/COLOR]
            BackEnd = GetFileName(Connection)
            
[COLOR="seagreen"]            'Only relink if a connection actually exists.[/COLOR]
            If Len(BackEnd) > 0 Then
            
[COLOR="seagreen"]                'Set a reference to the current tabledef object.[/COLOR]
                Set tdf = db.TableDefs(tdf.Name)
                
[COLOR="seagreen"]                'Build the new connection value.[/COLOR]
                tdf.Connect = ";DATABASE=" & BackendPath & "\" & BackEnd
                
[COLOR="seagreen"]                'Refresh the table link.[/COLOR]
                tdf.RefreshLink
            Else
            
[COLOR="seagreen"]                'There was an error determining the name of the back end.  Notify the user.[/COLOR]
                Msg = "Unable to relink table." & vbCrLf & _
                      "Table Name:" & vbTab & tdf.Name & vbCrLf & _
                      "Connection:" & vbTab & Connection
                MsgBox Msg, vbExclamation, AppTitle
                RelinkTables = False
            End If
        End If
        
[COLOR="seagreen"]        'Increment the loop counter.[/COLOR]
        LoopCounter = LoopCounter + 1
        
    Next tdf
    
RelinkTables_Exit:
    On Error Resume Next
    
[COLOR="seagreen"]    'Remove the progress meter.[/COLOR]
    SysCmd acSysCmdRemoveMeter
[COLOR="seagreen"]    'Clean up object references if required.[/COLOR]
    If Not db Is Nothing Then Set db = Nothing
    If Not tdf Is Nothing Then Set tdf = Nothing
    
    Exit Function

RelinkTables_Err:
    MsgBox "Error occurred" & vbCrLf & vbCrLf & _
    "In procedure:" & vbTab & ProcedureName & vbCrLf & _
    "Err Number: " & vbTab & Err.Number & vbCrLf & _
    "Description: " & vbTab & Err.Description, vbCritical
    Resume RelinkTables_Exit

End Function

 

[Frothingslosh]

Um, you'll want these too, I reference them in the procedure.

Public Function GetFileName(ByVal FullPath As String) As String
'**************************************************
'*  Created By:     Scott L Prince
'*  Created On:     10/2/13
'*  Modified:
'*  Purpose:        Returns a file name from the full path provided.
'*  Parameters:     Full path including file name
'*  Output:         File name, or empty string if no file name could be determined.
'*  Comments:
'**************************************************

On Error GoTo GetFileName_Err

Dim BackslashLocation As Long   'Location of the last "/" or "\" in the path
    
    'Defaults
    GetFileName = ""

    'Only necessary if a FullPath has actually been passed.
    If FullPath <> "" Then

        'Locate the FINAL backslash.
        BackslashLocation = InStrRev(FullPath, "\")
        
        'If no "\" was found, then check for "/" (sharepoint file structure).
        If BackslashLocation = 0 Then BackslashLocation = InStrRev(FullPath, "/")
        
        'Determine if a slash was found.
        If BackslashLocation > 0 Then
        
            'A slash was found, so return the file name.
            GetFileName = Right(FullPath, Len(FullPath) - BackslashLocation)
        Else
        
            'No slash found, so return FullPath as the file name.
            GetFileName = FullPath
        End If
    End If
    
GetFileName_Exit:
    Exit Function
    
GetFileName_Err:
    MsgBox "An error has occurred in procedure 'GetFileName'!" & vbCrLf & vbCrLf & _
           "Error:" & vbTab & vbTab & Err.Number & vbCrLf & _
           "Description:" & vbTab & Err.Description, vbOKOnly + vbCritical
    Resume GetFileName_Exit

End Function

Public Function GetFolder(ByVal FullPath As String, _
                          Optional ByVal IncludeLastSlash As Boolean = False) As String
'**************************************************
'*  Created By:     Scott L Prince
'*  Created On:     10/3/13
'*  Modified:
'*  Purpose:        Returns the folder portion of the supplied path (ie - C:\Temp\Test.doc returns C:\Temp)
'*  Parameters:     Full path including file name
'*  Output:         Path to indicated folder, or empty string if no folder was found.
'*  Comments:
'**************************************************

On Error GoTo GetFolder_Err

    'Defaults
    GetFolder = ""
    
    'Only execute if an actual value was passed to FullPath.
    If FullPath <> "" Then

        Dim BackslashLocation As Long   'Location of the FINAL backslash in the path.
        
        'Determine the location of the final backslash in the path.
        BackslashLocation = InStrRev(FullPath, "\")
        
        'If no "\" was found, then check for "/" (sharepoint file structure).
        If BackslashLocation = 0 Then BackslashLocation = InStrRev(FullPath, "/")
        
        'If there is a slash, use it to determine the path sans filename in FullPath.
        If BackslashLocation > 0 Then
            'If IncludeLastSlash is false, subtract 1 from Backslash location so the last one is not included.
            If Not IncludeLastSlash Then BackslashLocation = BackslashLocation - 1
            'Return the folder path.
            GetFolder = Left(FullPath, BackslashLocation)
        End If
    End If

GetFolder_Exit:
    Exit Function
    
GetFolder_Err:
    MsgBox "An error has occurred in procedure 'GetFolder'!" & vbCrLf & vbCrLf & _
           "Error:" & vbTab & vbTab & Err.Number & vbCrLf & _
           "Description:" & vbTab & Err.Description, vbOKOnly + vbCritical
    Resume GetFolder_Exit

End Function

 

[diofree]

Ok! Thank you sir!
So my process .... I would take this and build a macro with it, correct? What parts would I need to modify for my own use?

Sorry for the newb questions.

 

[Frothingslosh]

You should just be able to make a macro called AutoExec (it has to be that name exactly), and have it run the function RelinkTables. Just make sure all three functions I provided are saved in a module (and that the module doesn't share a name with any of the functions).

Assuming there isn't some Sharepoint weirdness that prevents the code from running at all, you should be fine: Access automatically runs AutoExec at startup, and both of the support functions I provided already check for Sharepoint file structure.

And as usual, make a backup of your front end before testing changes like this.