Illegal function call on Exit Function (1 Viewer)

mdjks

Registered User.
Local time
Today, 09:13
Joined
Jan 13, 2005
Messages
96
I have a bit of code to relink tables to a new location. My earlier tests were doing well but once I added a button with a run command I started getting Run-time error 7952 "You made an illegal function call". This occurs at Exit Function. I tried commenting that out and letting it run to End Function but I get the same error. The code otherwise works beautifully. Any suggestions would be appreciated.

Thank you in advance

Code:
Private Sub cmdRefresh_Click()
Run RefreshTableLinks
MsgBox "Tables Relinked"
End Sub

Code:
Public Function RefreshTableLinks() As String
On Error GoTo ErrHandle
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strCon As String
Dim strBackEnd As String
Dim strMsg As String
Dim intErrorCount As Integer
Dim strDBBEPath As String 'DataBase BackEnd Path
strDBBEPath = Environ("DBBEPATH")
If Len(strDBBEPath & "") = 0 Then
    strDBBEPath = CurrentProject.Path
End If
Set db = CurrentDb
'Loop through the TableDefs Collection.
For Each tdf In db.TableDefs
    'Verify the table  is a linked table.
    If Left$(tdf.Connect, 10) = ";DATABASE=" And InStr(tdf.Connect, "DWbe") Then
        'Get the  existing Connection String.
        strCon = Nz(tdf.Connect, "")
        'Get the name  of the back-end database using String Functions.
        strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "\") - 1)))
        'Verify we  have a value for the back-end
        If Len(strBackEnd & "") > 0 Then
            'Set a reference to the TableDef  Object.
            Set tdf = db.TableDefs(tdf.Name)
            'Build the  new Connection Property Value.
            tdf.Connect = ";DATABASE=" & strDBBEPath & strBackEnd
            'Refresh  the table link.
            tdf.RefreshLink
        Else
            'There was  a problem getting the name of the back-end.
            'Add the  information to the message to notify the user.
            intErrorCount = intErrorCount + 1
            strMsg = strMsg & "Error getting back-end database name." & vbNewLine
            strMsg = strMsg & "Table Name: " & tdf.Name & vbNewLine
            strMsg = strMsg & "Connect = " & strCon & vbNewLine
        End If
    End If
Next tdf
    
' Bugfix for Access 2010 "Invalid database object  reference" problem
' http://www.utteraccess.com/forum/Invalid-database-Object-R-t1953275.html
Dim QD As QueryDef
For Each QD In CurrentDb.QueryDefs
    QD.SQL = QD.SQL
Next

ExitHere:
On Error Resume Next
If intErrorCount > 0 Then
    strMsg = "There were errors refreshing the table links: " _
    & vbNewLine & strMsg & "in Procedure RefreshTableLinks."
    RefreshTableLinks = strMsg
End If
Set tdf = Nothing
Set db = Nothing
[COLOR="Red"]Exit Function 'Error occurs here[/COLOR]

ErrHandle:
intErrorCount = intErrorCount + 1
strMsg = strMsg & "Error " & Err.Number & " " & Err.Description
strMsg = strMsg & vbNewLine & "Table Name:  " & tdf.Name & vbNewLine
strMsg = strMsg & "Connect = " & strCon & vbNewLine
Resume ExitHere

End Function
 

MarkK

bit cruncher
Local time
Today, 07:13
Joined
Mar 17, 2004
Messages
8,187
Don't use Run.
Code:
Private Sub cmdRefresh_Click()
   RefreshTableLinks
   MsgBox "Tables Relinked"
End Sub
See if that makes a difference.
 

mdjks

Registered User.
Local time
Today, 09:13
Joined
Jan 13, 2005
Messages
96
Perfect and simple, thank you very much
 

Users who are viewing this thread

Top Bottom