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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Databases

From novice to tech pro — start learning today.