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.
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
                Debug.Print Timer, tdf.Name, tdf.SourceTableName, tdf.Connect
            End If
        End If
    For Each qdf In dbs.QueryDefs
        If qdf.Connect <> "" Then
            Debug.Print Timer, qdf.Name, qdf.Type, qdf.Connect
            qdf.Connect = strConnect
        End If
    Debug.Print "Done!"
    AttachSqlServer = True
    Set tdf = Nothing
    Set dbs = Nothing
    Exit Function
    Call ErrorMox
    Resume Exit_AttachSqlServer
End Function

Open in new window

It is called from here:

Private Sub btnOk_Click()
    If IsAttached = True Then
        DoCmd.Close acForm, Me.Name, acSaveNo
        Exit Sub
    End If
    If ConnectionCheck = True Then
        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
    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.
Gustav BrockCIOCommented:
Certainly. There is no need to delete the link tables, just refresh them with the (modified) connect info.
pabrannPresidentAuthor Commented:
Thanks, what is the VBA syntax to refresh them...
pabrannPresidentAuthor Commented:
Thank you very much!!! I was able to use parts of your code to adapt to my application. Works like a charm..
Gustav BrockCIOCommented:
You are welcome!
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.