Stop OnTimer Event when (1 Viewer)

Snowflake68 · May 18, 2018

When my application is launched an AutoExec macro opens a hidden Form. The hidden form opens a Splash Screen and runs code to relink the backend Access tables. I use a hidden form to run the code because I found that if I used the Splash screen to run the code then the form wouldn’t render to screen until after the code had finished running.

On the Splash screen I have a timer event that just closes the splash screen (and the hidden form) and then opens the main form (the main form is linked to one of the Backend Access tables). The timer event on the Splash screen still runs and proceeds to open the main form which then errors because it cannot link to the backend database.

How do I stop the timer event on the splash screen from running if there is an error linking the tables?

This is the code on the hidden form

Code:

Private Sub Form_Open(Cancel As Integer)

DoCmd.OpenForm "frmSplash"

    RefreshTableLinks
    
    Dim strMsg As String

'Run the Procedure, getting any error messages.
strMsg = RefreshTableLinks()

'strMsg will be a zero-length string if there is no error message.
    If Len(strMsg & "") = 0 Then
        Debug.Print "All; Tables; were; successfully; relinked."
    Else
        'Notify the user of the errors.
        MsgBox strMsg, vbCritical
    End If
End Sub

This is the code to re-link the Access Tables (from Microsoft website)

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

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=" 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, "\Data\BackendData") - 1))) ' amended this line to include the backend sub directory 'Data'
        '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=" & CurrentProject.Path & "\" & strBackEnd ' amended this line to include "\" &
                '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

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

Exit Function

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

This is the code behind the onTimer event of the splash form

Code:

Private Sub Form_Timer()
    DoCmd.Close acForm, "frmRefreshTables"
    DoCmd.Close acForm, "frmSplash"
    DoCmd.OpenForm "frmMain"
End Sub

Minty · May 18, 2018

Be aware you are calling RefreshTableLinks twice in that code.
Try in the error handler for refresh links setting the timer event time on the form to 0.

static · May 18, 2018

RefreshTableLinks generates an error string which your main sub displays.

A better way to use functions that do something rather than return a distinct value is to set the function to true if it runs without error.

This makes your code much more readable.

You could move the error message to the function or pass a variable for the function to set.

Code:

dim strmsg as string
if not RefreshTableLinks(strmsg) then
	forms("frmSplash").form.timerinterval = 0 'STOP TIMER ON SPLASH SCREEN
	MsgBox strMsg, vbCritical
else
	Debug.Print "All; Tables; were; successfully; relinked."
end if

Code:

Public Function RefreshTableLinks(byref msg as string) As boolean
on error goto eh
	
	'do stuff
	
	RefreshTableLinks = true
        exit sub
eh:
	RefreshTableLinks = false
	msg = err.description
end function

Snowflake68 · May 18, 2018

Minty said:
Be aware you are calling RefreshTableLinks twice in that code.

Thanks, I wondered why when I had a message to confirm it had run that I received the message twice. Where is it calling it twice?

Try in the error handler for refresh links setting the timer event time on the form to 0.

Thanks I will give that a go.

Snowflake68 · May 18, 2018

static said:
RefreshTableLinks generates an error string which your main sub displays.

A better way to use functions that do something rather than return a distinct value is to set the function to true if it runs without error.

This makes your code much more readable.

You could move the error message to the function or pass a variable for the function to set.

Code:

dim strmsg as string if not RefreshTableLinks(strmsg) then forms("frmSplash").form.timerinterval = 0 'STOP TIMER ON SPLASH SCREEN MsgBox strMsg, vbCritical else Debug.Print "All; Tables; were; successfully; relinked." end if

Code:

Public Function RefreshTableLinks(byref msg as string) As boolean on error goto eh 'do stuff RefreshTableLinks = true exit sub eh: RefreshTableLinks = false msg = err.description end function

Thanks I will give these a try next week.

Stop OnTimer Event when (1 Viewer)

Snowflake68

Registered User.

Minty

AWF VIP

static

Registered User.

Snowflake68

Registered User.

Snowflake68

Registered User.

Similar threads

Users who are viewing this thread