How to secure VBA linking SQL Server tables

I have an Access database with linked SQL Server tables. VBA code automatically loops through all linked tables and re-links them. However, when Access is an unstable state, I have had this procedure delete all links and not relink any of them.  Is there a way to test to see if the re-link is successful and if not, abort the process and have a message box with the offending table.  Thank you very much. I have attached a file with the VBA code.
LinkMicrosoftAccessTables.docx
pabrannPresidentAsked:
Who is Participating?
 
Gustav BrockCIOCommented:
Here's the main function we use:

Public Function AttachSqlServer( _
    ByVal Hostname As String, _
    ByVal Database As String, _
    ByVal Username As String, _
    ByVal Password As String) _
    As Boolean

' Attach all tables linked via ODBC to SQL Server or Azure SQL.
' 2016-04-24. Cactus Data ApS, CPH.

    Const cstrDbType    As String = "ODBC"
    Const cstrAcPrefix  As String = "dbo_"

    Dim dbs             As DAO.Database
    Dim tdf             As DAO.TableDef
    Dim qdf             As DAO.QueryDef
    
    Dim strConnect      As String
    Dim strName         As String
    
    On Error GoTo Err_AttachSqlServer
    
    Set dbs = CurrentDb
    strConnect = ConnectionString(Hostname, Database, Username, Password)
    
    For Each tdf In dbs.TableDefs
        strName = tdf.Name
        If Asc(strName) <> Asc("~") Then
            If InStr(tdf.Connect, cstrDbType) = 1 Then
                If Left(strName, Len(cstrAcPrefix)) = cstrAcPrefix Then
                    tdf.Name = Mid(strName, Len(cstrAcPrefix) + 1)
                End If
                tdf.Connect = strConnect
                tdf.RefreshLink
                Debug.Print Timer, tdf.Name, tdf.SourceTableName, tdf.Connect
                DoEvents
            End If
        End If
    Next
    
    For Each qdf In dbs.QueryDefs
        If qdf.Connect <> "" Then
            Debug.Print Timer, qdf.Name, qdf.Type, qdf.Connect
            qdf.Connect = strConnect
        End If
    Next
    Debug.Print "Done!"
    
    AttachSqlServer = True
    
Exit_AttachSqlServer:
    Set tdf = Nothing
    Set dbs = Nothing
    Exit Function
    
Err_AttachSqlServer:
    Call ErrorMox
    Resume Exit_AttachSqlServer
    
End Function

Open in new window

It is called from here:

Private Sub btnOk_Click()
    
    DisplayAttachResult
     
    If IsAttached = True Then
        DoCmd.Close acForm, Me.Name, acSaveNo
        Exit Sub
    End If
    
    If ConnectionCheck = True Then
        DisplayAttaching
        DoCmd.Hourglass True
        IsAttached = AttachSqlServer(Me!Hostname.Value, Me!Database.Value, Me!Username.Value, Me!PassWord.Value)
        DoCmd.Hourglass False
    End If
    
    DisplayAttachResult IsAttached
    
    If IsAttached Then
        WriteConfiguration
    End If

End Sub

Open in new window

which includes some form specific sub/helper functions not listed here, but you should get the idea.
0
 
Gustav BrockCIOCommented:
Certainly. There is no need to delete the link tables, just refresh them with the (modified) connect info.
0
 
pabrannPresidentAuthor Commented:
Thanks, what is the VBA syntax to refresh them...
0
 
pabrannPresidentAuthor Commented:
Thank you very much!!! I was able to use parts of your code to adapt to my application. Works like a charm..
0
 
Gustav BrockCIOCommented:
You are welcome!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.