Select Data Source window appears unexpectedly

Question

I have a front-end and back-end Access 2007 application.  After installing it in a client computer, the first time it runs, I get the Select Data Source window before my AutoExec macro starts.  How do I prevent it from appearing?

I'm guessing it has something to do with my connect strings pointing to a back-end database that doesn't exist.  That happens when the back-end database is installed in a different directory that what it was when I packaged the application.

Answer 1

The AutoExec macro calls a VBA function of the name AutoExec_Function. 

---

Public Function AutoExec_Function() As Integer

Dim prtyAppVersion As Property

Dim tdfTableDef As TableDef

Dim dbTemp As Database

Dim strFileDatabaseVersion As String

Dim i, j As Integer

Dim lngStatus As Long

Dim strTemp As String

Dim strLastWarehouse As String

Dim strCurDir As String

Dim strError As String

Dim boolFirstTime As Boolean

Dim strInstallVersion As String

Const conNonExistentTable As Long = 3011&

Const conNwindNotFound As Long = 3024&

Const conAccessDenied As Long = 3051&

Const conReadOnlyDatabase As Long = 3027&

Const conNotExist As Long = 3044&

Const cSysSerial As String = "00001-0001-0001-0001-0001-0083"

    On Error GoTo AutoExec_Function_Error

    Call LogMsg(1, "InstallDir - " & GetInstallPath())

    Call LogMsg(1, "BlankDB - " & CreateFileName(FILE_TYPE_BLANKDB, False))

    Call LogMsg(1, "UserDir - " & CreateFileName(CSIDL_MYDOCUMENTS, False))

    Call LogMsg(1, "PathPoint - " & CreateFileName(FILE_TYPE_COMMOMPATH, False))

'--- Call MsgBox("AutoExec 1 - Entry")

    '*******************************************************************

    '*** Initialization

    '*******************************************************************

    '*** Update times performed

    gboolProgressStatus = False

    Set gdbCurrentDb = CurrentDb()

    gintAutoExecPerformed = gintAutoExecPerformed + 1

    gLockCommonInUse = False

    '---lngStatus = GetOSVersion()

    gboolDirtyBusiness = False

    gstrAccessVersion = Application.Version '*** Access Version

    If Val(Left(gstrAccessVersion, 2)) >= 12 Then gboolAccess2007or2010 = True

    If Len(gstrForm_MenuType) = 0 Then      '*** Default Menu Type

        gstrForm_MenuType = "0"

    End If

'--- Call MsgBox("AutoExec 2 Acc Ver " & gstrAccessVersion)

    '*** String Constants for HTML Parsing

    gcstrHtml_DataMarker = Chr$(13) & Chr$(37) & Chr$(13) & Chr$(37) '-- x'0D250D25'

    gcstrHtml_DataMarkerEnd = Chr$(13) & Chr$(37)    '-- x'0D25'

    gcstrHtml_DataEnd = Chr$(80)                     '-- x'50'

    gcstrHtml_DataStart = Chr$(126)                  '--- EBCDIC "="

    '*** Host User Selected Language

    gintUserMS_LCID = GetUserDefaultLangID()         '*** User PC Language

    glngDefaultUserCodePage = GetDefaultMFUserCodePage()  '*** Default Mainframe Code Page

    glngDefaultSystemCodePage = GetDefaultMFSystemCodePage()

    If glngDefaultSystemCodePage = 0& Then

        glngDefaultSystemCodePage = GetDefaultMFSystemCodePage(37&)

    End If

    If glngDefaultUserCodePage = 0& Then

        glngDefaultUserCodePage = GetDefaultMFUserCodePage(glngDefaultSystemCodePage)

    End If

'--- Call MsgBox("AutoExec 3 Lang ID " & CStr(gintUserMS_LCID))

    Call LogMsg(1, "Lang ID " & CStr(gintUserMS_LCID))

    '*** Get Language Tables

    Call GetLangTable(glngDefaultUserCodePage, cUserCodePage)

    Call GetLangTable(glngDefaultSystemCodePage, cSystemCodePage)

'--- Call MsgBox("AutoExec 4 Code Page " & CStr(glngDefaultUserCodePage))

    Call LogMsg(1, "Code Page " & CStr(glngDefaultUserCodePage))

    '*** Get Product Serial Number

    gstrProductSerialNo = GetSerialNumber()

'--- Call MsgBox("AutoExec 5 Serial No " & gstrProductSerialNo)

    Call LogMsg(1, "Serial No " & CStr(gstrProductSerialNo))

    '*******************************************************************

    '*** Initialize Menus and Workgroup File

    '*******************************************************************

#If Production Then

    '*** Check for Run Time version

    '   (If not, then the user is opening the file with MS Office directly.)

    If Not SysCmd(acSysCmdRuntime) And _

        StrComp(gstrProductSerialNo, cSysSerial, vbTextCompare) <> 0 Then

        Call LogMsg(1, "Not Access runtime version - abort")

        GoTo AutoExec_Function_Abort

    End If

    '*** Reset compaction indicator

    AddAppProperty "Auto Compact", dbInteger, 1

    '*** Check for valid printer

    CheckPrinter

    If Not gboolAccess2007or2010 Then

        '*** Set Menus

        Application.MenuBar = "PPMain"

        Application.ShortcutMenuBar = "PopupGeneral"

    End If

#End If

    '*******************************************************************

    '*** Enable Language Translation

    '*******************************************************************

#If APPeXRC Then

    If objAPPeXRC Is Nothing Then

        Set objAPPeXRC = CreateObject("APPeXRC.GetStrings")    '-- APPeX RC Server

    End If

#End If

    '*******************************************************************

    '*** Get installed software Registry Settings

    '*******************************************************************

    '*** Get All Installed Versions  X.X

    strInstallVersion = GetInstallVersion()

    strTemp = GetRegEntry(HKEY_LOCAL_MACHINE, GetRegistryKey(HKEY_LOCAL_MACHINE, REGKEY_INSTALLS), True)

    i = InStr(1, strTemp, strInstallVersion & vbNullChar, vbTextCompare)

'--- Call MsgBox("AutoExec 7 GetInstallVersion " & strInstallVersion)

    Call LogMsg(1, "Highest Install Version " & CStr(strInstallVersion))

    Call LogMsg(1, "Running Version " & gstrACSWarehouseVersion)

'--    If Len(strInstallVersion) = 0 Or _

'--        StrComp(strInstallVersion, gstrACSWarehouseVersion, _

'--        vbTextCompare) <> 0 Then

'--   If Len(strInstallVersion) = 0 Or _

'--     Val(strInstallVersion) < Val(gstrACSWarehouseVersion) Then

    If i = 0 Then           '*** Running a version that is not Installed

        strInstallVersion = gstrACSWarehouseVersion

        '***************************************************************

        '*** Setup Install Registry Entries

        '***************************************************************

'--- Call MsgBox("AutoExec 8 call InitInstall " & gstrACSWarehouseVersion)

        If Not InitInstall(strInstallVersion, _

            CreateFileName(FILE_TYPE_INSTALLPATH, False), glngACSWarehouseRelease) Then

            GoTo AutoExec_Function_Abort

        End If

    End If

    '*** Get Installed Path

    If SysCmd(acSysCmdRuntime) Then

        '*** Production

        gstrInstallPath = GetInstallPath(, vntRelease:=gstrACSWarehouseVersion)

        gstrAPPeXHelpFullName = CreateFileName(FILE_TYPE_INSTALLPATH, False) & gstrHelpFileName

    Else

        '*** Non-production

        gstrInstallPath = GetInstallPath(NewValue:=CreateFileName(FILE_TYPE_INSTALLPATH, False), _

            vntRelease:=gstrACSWarehouseVersion)

        gstrAPPeXHelpFullName = gstrInstallPath & gstrHelpFileName

    End If

'--- Call MsgBox("AutoExec 9 call Install Path " & gstrInstallPath)

    Call LogMsg(1, "Install path " & CStr(gstrInstallPath))

    '*** Get Release Number  y.y.X

    glngInstallRelease = GetInstallRelease()

    If glngInstallRelease = 0& Or _

        glngACSWarehouseRelease <> glngInstallRelease Then

        glngInstallRelease = GetInstallRelease(NewValue:=glngACSWarehouseRelease)

    End If

'--- Call MsgBox("AutoExec 10 call Install Release " & glngInstallRelease)

    Call LogMsg(1, "Install release " & CStr(glngInstallRelease))

    '*** Get Service Pack

    gstrServicePack = CStr(GetServicePack())

'--- Call MsgBox("AutoExec 11 " & gstrServicePack)

    Call LogMsg(1, "Install service pack " & CStr(gstrServicePack))

    '*** Get Help File

    If SysCmd(acSysCmdRuntime) Then

        '*** Check Serial Number validity

        If CheckProductSerialNo(gstrProductSerialNo, True, True) < 0 Then

            If Not MenuProductKey() Then

                DisplayError "Invalid Product Serial number." & vbCrLf & _

                        "PathPoint aborted."

                    GoTo AutoExec_Function_Abort

            End If

        End If

    End If

    '*******************************************************************

    '*** Get version of software database (i.e., frontend or *.mde) database

    '***   (THAT's ME DUMMY!)

    '*******************************************************************

    Set dbTemp = gdbCurrentDb

    gstrFileVersion = Nz(GetDBProperty(dbTemp, gcstrDBProp_AppVersion), "")

    Call LogMsg(1, "File create version " & gstrFileVersion)

    '*** Set Warehouse Version in Database

    If Not SysCmd(acSysCmdRuntime) Then

        If gstrFileVersion <> gstrACSWarehouseVersion Then

            gstrFileVersion = gstrACSWarehouseVersion

            GetDBProperty dbTemp, gcstrDBProp_AppVersion, vntPropValue:=gstrACSWarehouseVersion

        End If

    End If

    Set dbTemp = Nothing

    '*******************************************************************

    '*** Check for linked DB files

    '*******************************************************************

    '*** Check for Linked File as Default Database

    If SysCmd(acSysCmdRuntime) Then

        '--------------------------------------------------

        '*** Link to Last Warehouse (Normal Processing)

        '--------------------------------------------------

        strLastWarehouse = GetLastWarehouse()

        If Len(strLastWarehouse) = 0 Or _

            StrComp(GetFileName(strLastWarehouse), gstrBlankFileName, vbTextCompare) = 0 Then

            '*** First Start of Application

            'GoSub LinkToDefault

            'Call GetLastWarehouse(gstrLinkedDBName)

            Call MenuNewDatabase

        ElseIf Len(strLastWarehouse) > 0 And FileExists(strLastWarehouse) Then

            If TrustedLocation(strLastWarehouse) Then

                Call RelinkTables(gstrLinkedDBName, False, False)

                strCurDir = GetPathName(strTemp)

            Else

                DisplayError "Last warehouse opened is not in Trusted Location." & vbCrLf & _

                    strLastWarehouse & vbCrLf & _

                    "Opening default database."

                If MenuOpenDatabase() <> 0 Then

                    Call MenuNewDatabase

                End If

                'GoSub LinkToDefault

                'Call GetLastWarehouse(gstrLinkedDBName)

            End If

        Else

            '--------------------------------------------------

            '*** Last Warehouse Not Valid (Open File)

            '--------------------------------------------------

            'GoSub LinkToDefault

            'Call GetLastWarehouse(gstrLinkedDBName)

            If MenuNewDatabase() <> 0 Then

                Call MenuOpenDatabase

            End If

        End If

    Else

        '--------------------------------------------------

        '*** Testing on Linked Database

        '--------------------------------------------------

        'Call RelinkTables(gstrLinkedDBName, False, True)

        gstrLinkedDBName = GetLinkedDBName()

        If Len(gstrLinkedDBName) > 0 Then

            strCurDir = GetPathName(gstrLinkedDBName)

            Call OpenBackEnd

        Else

            '--------------------------------------------------

            '*** Non-Linked Database

            '--------------------------------------------------

            Set gdbCurrentDbTables = gdbCurrentDb

            gstrLinkedDBName = gdbCurrentDb.Name

        End If

    End If

    Call LogMsg(1, "Linked file " & gstrLinkedDBName)

    '*******************************************************************

    '*** Update Scenario Scale factors

    '*******************************************************************

AutoExec_Function_Error3_Resume:

    On Error GoTo AutoExec_Function_Error

    glngMaxScaleFactor = -1&

    ScenScaleBuild

    '*******************************************************************

    '*** Check file DB changes for Version 1.2.5 and above

    '*******************************************************************

    If AutoExec_DBChange() <> -1& Then

        GoTo AutoExec_Function_Abort

    End If

    '*******************************************************************

    '*** Get version of Tables

    '*******************************************************************

    '*** Determine current backend database version

    Set dbTemp = gdbCurrentDbTables

    strFileDatabaseVersion = Nz(GetDBProperty(dbTemp, gcstrDBProp_AppVersion), "")

    If SysCmd(acSysCmdRuntime) Then

        '*** Production  (Perform test when database cannot be updated)

        'If Nz(StrComp(strFileDatabaseVersion, gstrACSWarehouseVersion, 1), 1) <> 0 Then

        '    DisplayError "Inconsistent versions on software (e.g., frontend) and warehouse (e.g., backend) databases." & vbCrLf & _

        '        "Software (" & gstrFileVersion & ") vs Warehouse(" & strFileDatabaseVersion & ")" & vbCrLf & _

        '        "Either link " & gstrAppName & " Warehouse to appropriate version or " & vbCrLf & _

        '        "results are unpredictable!"

        'End If

    Else

        '*** Test

        If strFileDatabaseVersion <> gstrACSWarehouseVersion Then

            strFileDatabaseVersion = gstrACSWarehouseVersion

            GetDBProperty dbTemp, gcstrDBProp_AppVersion, vntPropValue:=strFileDatabaseVersion

        End If

    End If

    '*******************************************************************

    '*** Display file name on Status bar

    '*******************************************************************

    i = DisplayStatus()

    '*******************************************************************

    '*** Initialize common arrays defined in this Module

    '*******************************************************************

    ReDim gTrigInst(0 To 0)

    GetDBAccessMethods      '*** Builds "gstrAccessMethod" array

    '*** User screen background color

    glngBackColor_Screens = 12371643

    '*********************************************

    '   Exit

    '*********************************************

AutoExec_Function_Exit:

    Set prtyAppVersion = Nothing

    Set tdfTableDef = Nothing

    Set dbTemp = Nothing

    Call UpdateGlobals              '*** Make sure we have pointers to globals

    DisplayStatus

    gboolGoHome = False

    Exit Function

    '*********************************************

    '   Exit - Error

    '*********************************************

AutoExec_Function_Abort:

    Call UpdateGlobals              '*** Make sure we have pointers to globals

    Application.Quit acQuitSaveNone

    Exit Function

'*******************************************************************

'*** Subroutines

'*******************************************************************

LinkToDefault:

    gstrLinkedDBName = CreateFileName(FILE_TYPE_DEFAULT, False)

    Call RelinkTables(gstrLinkedDBName, False, False)

    Return

FindOutWhy:

    strError = ""

    lngStatus = CheckLinks()

    If lngStatus <> 0& Then

        Select Case lngStatus

            Case conNonExistentTable

                strError = "File '" & gstrLinkedDBName & vbCrLf & _

                "' does not contain the required tables."

            Case conAccessDenied

                strError = "Could not open " & gstrLinkedDBName & vbCrLf & _

                " because it either is not located in the directory," & vbCrLf & _

                "is a read-only file or is located on a read-only share directory."

            Case conReadOnlyDatabase

                strError = "Cannot reattach tables in " & gstrLinkedDBName & vbCrLf & _

                " because it is read-only or is located on a read-only share."

            Case conNotExist

                strError = "File '" & gstrLinkedDBName & vbCrLf & _

                "' was not found."

            Case Else

                strError = "Error " & CStr(lngStatus)

        End Select

    End If

    DisplayError strError

    Return

'***********************************************************************

'*** Error Handler

'***********************************************************************

AutoExec_Function_Error3:

    '*** Error linking to warehouse

    '*** Create new warehouse from BlankDB.mdb

    strTemp = CreateNewDatabase("")

    If Len(strTemp) = 0 Then

        Resume AutoExec_Function_Exit

    End If

    Resume AutoExec_Function_Error3_Resume

AutoExec_Function_Error:

    DisplayError Err.Description, Err.Number

    GoTo AutoExec_Function_Exit

End Function

Public Function OpenBackEnd() As Boolean

    On Error GoTo OpenBackEnd_Error

    OpenBackEnd = True

    If StrComp(Right(gstrLinkedDBName, 5), "accdb", vbTextCompare) = 0 Then

        Set gdbCurrentDbTables = DBEngine(0).OpenDatabase(gstrLinkedDBName, gboolOpenMode, False, gstrAccess2007Connect)

    Else

        Set gdbCurrentDbTables = DBEngine(0).OpenDatabase(gstrLinkedDBName, gboolOpenMode)

    End If

OpenBackEnd_Exit:

    Exit Function

OpenBackEnd_Error:

    DisplayError Err.Description, Err.Number

    OpenBackEnd = False

    Resume OpenBackEnd_Exit

End Function

Public Function RelinkTables(ByRef strBackendDBName As String, boolCopyCurrent As Boolean, _

            boolUpdateLast As Boolean) As Boolean

Dim i As Integer

Dim tdf As TableDef

Dim boolReturn As Boolean

Dim strTableName As String

Dim strTemp As String

Dim boolSplitDatabase As Boolean

Dim boolTryBlankPSWD As Boolean

    On Error GoTo RelinkTables_Error

    '*******************************************************************************

    '*** Initialize

    '*******************************************************************************

    If Len(strBackendDBName) = 0 Then

        GoTo RelinkTables_Exit

    End If

    boolReturn = True           '*** Assume successful

    DisplayStatus "Opening... " & strBackendDBName

    If gdbCurrentDb Is Nothing Then Call UpdateGlobals

    '*******************************************************************************

    '*** Close Current Tables Database

    '*******************************************************************************

#If Production Then

    boolSplitDatabase = True

#Else

    If Len(Nz(CurrentDb().TableDefs("Application").Connect, "")) > 0 Then boolSplitDatabase = True

    If boolSplitDatabase Then

        If Not (gdbCurrentDbTables Is Nothing) Then

            gdbCurrentDbTables.CLOSE

            Set gdbCurrentDbTables = Nothing

        End If

    Else

        Set gdbCurrentDbTables = CurrentDb()

        GoTo RelinkTables_Exit

    End If

#End If

    If boolSplitDatabase Then

        If Not (gdbCurrentDbTables Is Nothing) Then

            gdbCurrentDbTables.CLOSE

            Set gdbCurrentDbTables = Nothing

        End If

    Else

        Set gdbCurrentDbTables = CurrentDb()

        GoTo RelinkTables_Exit

    End If

    '*******************************************************************************

    '*** Copy Current Database (Used in SaveAs Menu Option)

    '*******************************************************************************

    If boolCopyCurrent Then

        '*** Make copy of current database

        FileCopy gstrLinkedDBName, strBackendDBName

    End If

    '*******************************************************************************

    '*** Open Linked Database

    '*******************************************************************************

    gstrLinkedDBName = strBackendDBName

    If Not OpenBackEnd() Then

        DisplayError "Problem opening database."

        boolReturn = False

        GoTo RelinkTables_Exit

    End If

    '*******************************************************************************

    '*** Link Tables in Current Database

    '*******************************************************************************

    On Error GoTo RelinkTables_Error_Password    '*** Avoid errors on missing tables (Old versions)

If gboolAccess2007or2010 Then

    strTemp = ";DATABASE=" & strBackendDBName & ";PWD=" & gstrAccess2007pwd

Else

    strTemp = ";DATABASE=" & strBackendDBName

End If

    For Each tdf In gdbCurrentDb.TableDefs

        '*** NOTE: If the table has a connect string, it's a linked table.

        '*** Check for locally defined tables

        If StrComp(tdf.Name, gcstrTempKeysName, vbTextCompare) <> 0 And _

            StrComp(tdf.Name, "CodePage", vbTextCompare) <> 0 Then

            If (tdf.Attributes = 0 Or tdf.Attributes = &H40000000) And _

                Len(tdf.Connect) > 0 Then

                tdf.Connect = strTemp

                '*** Refresh Link

                tdf.RefreshLink         ' Relink the table.

                i = i + 1

            End If

        End If

    Next tdf

    Set tdf = Nothing

    On Error GoTo RelinkTables_Error

    '*******************************************************************************

    '*** Check tables database version

    '*******************************************************************************

    Call AutoExec_DBChange

    '*******************************************************************************

    '*** Set Default Directory

    '*******************************************************************************

    strTableName = GetPathName(gstrLinkedDBName)

    If StrComp(Right(strTableName, 1), "", vbBinaryCompare) = 0 Then

        strTableName = Left(strTableName, Len(strTableName) - 1)

    End If

    strTemp = GetDefAccessDir()

    If StrComp(strTemp, strTableName, vbTextCompare) <> 0 Then

        strTemp = GetDefAccessDir(NewValue:=strTableName)

    End If

    Call LogMsg(1, "Opening ... " & gstrLinkedDBName)

    Call SetCurrentDirectory(GetPathName(gstrLinkedDBName))

    '*******************************************************************************

    '*** Update Last Warehouse opened

    '*******************************************************************************

    If boolUpdateLast Then Call GetLastWarehouse(gstrLinkedDBName)

'***********************************************************************************

'*** Exit

'***********************************************************************************

RelinkTables_Exit:

    If Not boolSplitDatabase Then

        DisplayError "The database is not a split database." & vbCrLf & _

                    "Link operation unsuccessful."

        boolReturn = False

    End If

    RelinkTables = boolReturn

    gintParseStatus = 0         '*** Reset Warehouse with Parse Tables

    Call GetParseStatus         '*** Get current file parse status

    DisplayStatus

    Exit Function

'***********************************************************************************

'*** Error handler

'***********************************************************************************

RelinkTables_Error:

    DisplayError Err.Description, Err.Number

    boolReturn = False

    Resume Next

RelinkTables_Error_Password:

    If Err.Number = 3011 Then      '*** Cannot find table - After linking rebuilds

        Resume Next

    End If

    If Not boolTryBlankPSWD Then

        boolTryBlankPSWD = True

        strTemp = ";DATABASE=" & strBackendDBName

        Resume

    End If

    If Err.Number = 3027& Then      '*** Read Only Database Message

        Resume Next

    End If

    DisplayError "Invalid password or file format." & vbCrLf & "Open another database.", True

    Resume RelinkTables_Exit

End Function

Answer 2

I couldn't reproduce this behavior without AutoExec Macro. Thus this behavior might be related with the AutoExec Macro you used.

Please check the AutoExec Macro or post it here.