[Resolvido]Módulo para checar vínculo e reanexar

Olá!
Uso a função fRefreshLinks (do módulo abaixo) na macro AutoExec para checar o vínculo com o backend. Funciona muito bem, mas gostaria de fazer algumas alterações e não entendo a maior parte do código.
Peço a ajuda dos colegas mais experientes no sentido de comentar o código da maneira mais clara possível.
Obrigado!
Segue o módulo:

Option Compare Database
Option Explicit

Const IntAttachedTableType As Integer = 6
Const ALLFILES = "Todos os arquivos"

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
                          Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean

Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Function fGetMDBName(strIn As String) As String
'Calls GetOpenFileName dialog
Dim strFilter As String

    strFilter = ahtAddFilterItem(strFilter, _
                                                "Access Database(*.mdb;*.mda;*.mde;*.mdw) ", _
                                                "*.mdb; *.mda; *.mde; *.mdw")
    strFilter = ahtAddFilterItem(strFilter, _
                                                  "All Files (*.*)", _
                                                  "*.*")

    fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _
                                                                      OpenFile:=True, _
                                                                      DialogTitle:=strIn, _
                                                                      flags:=ahtOFN_HIDEREADONLY)
End Function
                  
Function fRefreshLinks() As Boolean
Dim dbs As Database
Dim rst As Recordset, rstTry As Recordset
Dim tdf As TableDef
Dim strOldConnect As String, strNewConnect As String
Dim strFullLocation As String, strDatabase As String, strMsg As String

    Set dbs = CurrentDb()
    Set rst = dbs.OpenRecordset("SELECT MSysObjects.Connect, MsysObjects.Database, " & _
                                               "MSysObjects.Name from MSysObjects " & _
                                               "WHERE MSysObjects.Type = " & IntAttachedTableType)
    If rst.RecordCount <> 0 Then
        rst.MoveFirst
        Do
            On Error Resume Next
            Set rstTry = dbs.OpenRecordset(rst![Name].Value)
            If Err = 0 Then
                rstTry.Close
                Set rstTry = Nothing
            Else
                On Error GoTo fRefreshLinks_Err
                strFullLocation = rst!Database
                strDatabase = FileName(strFullLocation)
                Set tdf = dbs.TableDefs(rst![Name].Value)
                strOldConnect = tdf.Connect
                strNewConnect = findConnect(strDatabase, tdf.Name, strOldConnect)
                For Each tdf In dbs.TableDefs
                    If tdf.Connect = strOldConnect Then
                        tdf.Connect = strNewConnect
                        tdf.RefreshLink
                    End If
                Next tdf
                dbs.TableDefs.Refresh
            End If
            Err = 0
            rst.MoveNext
            If rst.EOF Then
                Exit Do
            End If
        Loop
    End If

fRefreshLinks_End:
    Set tdf = Nothing
    Set rst = Nothing
    Set rstTry = Nothing
    fRefreshLinks = True
    Exit Function

fRefreshLinks_Err:
    fRefreshLinks = False
    Select Case Err
        Case 3024:
        Case Else:
            strMsg = "Informação de Erro..." & vbCrLf & vbCrLf
            strMsg = strMsg & "Função: fRefreshLinks" & vbCrLf & vbCrLf
            strMsg = strMsg & "Descrição: " & Err.Description & vbCrLf & vbCrLf
            strMsg = strMsg & "Erro #: " & Format$(Err.Number) & vbCrLf
            MsgBox strMsg, vbOKOnly + vbCritical, "ERRO!!!"
    End Select
    Exit Function
End Function

Function findConnect(strDatabase As String, strFileName As String, strConnect As String) As Variant
Dim strSearchPath As String, strFileType As String, strFileSkelton As String
Dim aExtension(6, 1) As String, i As Integer, strFindFullPath As String, strFindPath As String, strParameters As String
                      
    strSearchPath = directoryFromConnect(strConnect)
    strFileType = "Todos os Arquivos"
    strFileSkelton = "*.*"
    aExtension(0, 0) = "dBase"
    aExtension(0, 1) = ".dbf"
    aExtension(1, 0) = "Paradox"
    aExtension(1, 1) = ".db"
    aExtension(2, 0) = "FoxPro"
    aExtension(2, 1) = ".dbf"
    aExtension(3, 0) = "Excel"
    aExtension(3, 1) = ".xls"
    aExtension(4, 0) = "Text"
    aExtension(4, 1) = ".txt"
    aExtension(5, 0) = "Exchange"
    aExtension(5, 1) = ".*"
    aExtension(6, 0) = "Access"
    aExtension(6, 1) = ".mdb"
    For i = 0 To 6
        If InStr(strConnect, aExtension(i, 0)) <> 0 Then
            strFileName = strFileName & aExtension(i, 1)
            strFileSkelton = "*" & aExtension(i, 1)
            strFileType = aExtension(i, 0)
            Exit For
        End If
    Next i
    strFindFullPath = findFile(strDatabase, strSearchPath, strFileType, strFileSkelton)
    If strFindFullPath <> "" Then
        strFindPath = strPathfromFileName(strFindFullPath)
        strParameters = parametersFromConnect(strConnect)
        If InStr(strFindFullPath, "dbf") <> 0 Then
            findConnect = strParameters & strFindPath
        Else
            findConnect = strParameters & strFindFullPath
        End If
    End If
End Function
                  
Function directoryFromConnect(strConnect As String) As String
    directoryFromConnect = Mid(strConnect, InStr(strConnect, "DATABASE=") + 9)
End Function
                  
Function parametersFromConnect(strConnect As String) As String
    parametersFromConnect = Left(strConnect, InStr(strConnect, "DATABASE=") + 8)
End Function
                  
Function strPathfromFileName(strFileName As String) As String
Dim i As Integer
    For i = Len(strFileName) To 1 Step -1
        If Mid(strFileName, i, 1) = "\" Then
            Exit For
        End If
    Next i
    strPathfromFileName = Left(strFileName, i - 1)
End Function
                  
Function findFile(strDatabase, strSearchPath, strFileType, strFileSkelton) As String
Dim strSelectedDatabase As String, strFullLocation As String, intlen As Integer, i As Integer
Dim strIn As String
                      
    Do
        strIn = "Onde está  " & strDatabase & "?"
        findFile = Trim(fGetMDBName(strIn))
        strSelectedDatabase = FileName(findFile)
        If strSelectedDatabase = "" Then
            Exit Do
        ElseIf strDatabase <> strSelectedDatabase Then
            MsgBox "Você selecionou " & strSelectedDatabase & ". Esta não é a base de dados correta. Procure por " & strDatabase & ".", vbInformation + vbOKOnly
        End If
    Loop Until strSelectedDatabase = strDatabase
End Function

Public Function FileName(strFullLocation As String)
Dim intlen As Integer, i As Integer
                    
    intlen = Len(strFullLocation)
    For i = intlen To 1 Step -1
        If Mid$(strFullLocation, i, 1) = "\" Then
            FileName = Right$(strFullLocation, intlen - i)
            Exit For
        End If
    Next i
End Function

Function TestIt()
Dim strFilter As String
Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, "Access Files (*.mda, *.mdb)", "*.MDA;*.MDB")
    strFilter = ahtAddFilterItem(strFilter, "dBASE Files (*.dbf)", "*.DBF")
    strFilter = ahtAddFilterItem(strFilter, "Text Files (*.txt)", "*.TXT")
    strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    MsgBox "Você selecionou: " & ahtCommonFileOpenSave(InitialDir:="C:\", _
                             Filter:=strFilter, FilterIndex:=3, flags:=lngFlags, _
                             DialogTitle:="Hello! Abra-me!!!")
    Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
                                  Optional varTitleForDialog As Variant) As Variant
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
    lngFlags = ahtOFN_FILEMUSTEXIST Or ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
        varDirectory = ""
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = ""
    End If
    strFilter = ahtAddFilterItem(strFilter, "Access (*.mdb)", "*.MDB;*.MDA")
    varFileName = ahtCommonFileOpenSave( _
                                                                    OpenFile:=True, _
                                                                    InitialDir:=varDirectory, _
                                                                    Filter:=strFilter, _
                                                                    flags:=lngFlags, _
                                                                    DialogTitle:=varTitleForDialog)
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    GetOpenFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
                                 Optional ByRef flags As Variant, _
                                 Optional ByVal InitialDir As Variant, _
                                 Optional ByVal Filter As Variant, _
                                 Optional ByVal FilterIndex As Variant, _
                                 Optional ByVal DefaultExt As Variant, _
                                 Optional ByVal FileName As Variant, _
                                 Optional ByVal DialogTitle As Variant, _
                                 Optional ByVal hWnd As Variant, _
                                 Optional ByVal OpenFile As Variant) As Variant
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(flags) Then flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(FileName) Then FileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hWnd) Then hWnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hWnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .flags = flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        .hInstance = 0
        .strCustomFilter = ""
        .nMaxCustFilter = 0
        .lpfnHook = 0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If
    If fResult Then
        If Not IsMissing(flags) Then flags = OFN.flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function

Function ahtAddFilterItem(strFilter As String, strDescription As String, Optional varitem As Variant) As String
    If IsMissing(varitem) Then varitem = "*.*"
    ahtAddFilterItem = strFilter & strDescription & vbNullChar & varitem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function

O que eu preciso é que após a checagem dos vínculos, o código me informe se está tudo ok ou não, e parasse. Se o backend não foi encontrado um botão dispararia a sequência de revinculação.

Estou a puxar o tópico para cima. se já tiver resolvido, agradeço o seu retorno.

Se alguém tiver algum exemplo, por favor informe.
Obrigado!