Results 1 to 4 of 4
  1. #1
    2 Star Lounger
    Join Date
    Jan 2002
    Location
    Brugge, Belgium
    Posts
    144
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Standard Windows File OpenSave dialog dont permit (MS access 2007)

    A lot of code sample concerning linking attached tables, uses the standard Windows File OpenSave dialog file.
    But this dialog box makes it possible to make a choice among *.mdb or *.mda files, but not *.accdb files. How can we adapt this file, or does there exist an upgrade of this file that makes these choice possible?

  2. #2
    Super Moderator
    Join Date
    Jun 2002
    Location
    Mt Macedon, Victoria, Australia
    Posts
    3,993
    Thanks
    1
    Thanked 45 Times in 44 Posts

    Re: Standard Windows File OpenSave dialog dont permit (MS access 2007)

    Do you get a *.* option?

    I have code that starts:
    Dim objFileDialog As FileDialog
    Set objFileDialog = FileDialog(msoFileDialogOpen)

    When I use it on Win XP and Access 2003, I only see mdb and similar Access file types listed. But on a Vista machine with Access 2007, the list includes accdb and other 2007 formats.
    What code are you using to generate the Dialog.
    Attached Images Attached Images
    Regards
    John



  3. #3
    2 Star Lounger
    Join Date
    Jan 2002
    Location
    Brugge, Belgium
    Posts
    144
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Standard Windows File OpenSave dialog dont permit (MS access 2007)

    I use the code here beneath.
    As you will see in the function fGetMDBName, there's no "*.accdb ", only files with the suffixes for the older versions of MS Access, as *.mdb etc.
    I tried to append " *.accdb" in this function what didn't result in a error during compiling. Running this changed function let me see the *.accbd backend i search for, but choosing this file results in anothertime showing the dialog asking for a search for the back-end database, It seems the function couldn't find the chosen " *.accdb " file.
    Indeed as you mentioned, there is a " *.* " foreseen in this function, and thus keeping the function as it was original, it works fine.
    I only wonder why the changing I described above doesn't work?

    Thanks for your help.


    'Code courtesy of
    'Dev Ashish

    Function fRefreshLinks() As Boolean
    Dim strMsg As String, collTbls As Collection
    Dim i As Integer, strDBPath As String, strTbl As String
    Dim dbCurr As Database, dbLink As Database
    Dim tdfLocal As TableDef
    Dim varRet As Variant
    Dim strNewPath As String

    Const cERR_USERCANCEL = vbObjectError + 1000
    Const cERR_NOREMOTETABLE = vbObjectError + 2000

    On Local Error GoTo fRefreshLinks_Err

    If MsgBox("Are you sure you want to reconnect all Access tables?", _
    vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.Raise cERR_USERCANCEL

    'First get all linked tables in a collection
    Set collTbls = fGetLinkedTables

    'now link all of them
    Set dbCurr = CurrentDb

    strMsg = "Do you wish to specify a different path for the Access Tables?"

    If MsgBox(strMsg, vbQuestion + vbYesNo, "Alternate data source...") = vbYes Then
    strNewPath = fGetMDBName("Please select a new datasource")
    Else
    strNewPath = vbNullString
    End If

    For i = collTbls.Count To 1 Step -1
    strDBPath = fParsePath(collTbls(i))
    strTbl = fParseTable(collTbls(i))
    varRet = SysCmd(acSysCmdSetStatus, "Now linking '" & strTbl & "'....")
    If Left$(strDBPath, 4) = "ODBC" Then
    'ODBC Tables
    'ODBC Tables handled separately
    ' Set tdfLocal = dbCurr.TableDefs(strTbl)
    ' With tdfLocal
    ' .Connect = pcCONNECT
    ' .RefreshLink
    ' collTbls.Remove (strTbl)
    ' End With
    Else
    If strNewPath <> vbNullString Then
    'Try this first
    strDBPath = strNewPath
    Else
    If Len(Dir(strDBPath)) = 0 Then
    'File Doesn't Exist, call GetOpenFileName
    strDBPath = fGetMDBName("'" & strDBPath & "' not found.")
    If strDBPath = vbNullString Then
    'user pressed cancel
    Err.Raise cERR_USERCANCEL
    End If
    End If
    End If

    'backend database exists
    'putting it here since we could have
    'tables from multiple sources
    Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

    'check to see if the table is present in dbLink
    strTbl = fParseTable(collTbls(i))
    If fIsRemoteTable(dbLink, strTbl) Then
    'everything's ok, reconnect
    Set tdfLocal = dbCurr.TableDefs(strTbl)
    With tdfLocal
    .Connect = ";Database=" & strDBPath
    .RefreshLink
    collTbls.Remove (.Name)
    End With
    Else
    Err.Raise cERR_NOREMOTETABLE
    End If
    End If
    Next
    fRefreshLinks = True
    varRet = SysCmd(acSysCmdClearStatus)
    MsgBox "Alle Access tabellen werden succesvol gekoppeld aan de Data databas.", _
    vbInformation, vbOKOnly, _
    "Success"

    fRefreshLinks_End:
    Set collTbls = Nothing
    Set tdfLocal = Nothing
    Set dbLink = Nothing
    Set dbCurr = Nothing
    Exit Function
    fRefreshLinks_Err:
    fRefreshLinks = False
    Select Case Err
    Case 3059:

    Case cERR_USERCANCEL:
    MsgBox "Er werd geen Database gespecifieerd, het koppelen van de tabellen was niet mogelijk.", _
    vbCritical + vbOKOnly, _
    "Fout bij het verfrissen van de koppelingen."
    Resume fRefreshLinks_End
    Case cERR_NOREMOTETABLE:
    MsgBox "Tabel '" & strTbl & "' werd niet gevonden in de database" & _
    vbCrLf & dbLink.Name & ". Niet mogelijk de koppelingen tot stand te brengen", _
    vbCritical + vbOKOnly, _
    "Fout bij het verfrissen van de koppelingen."
    Resume fRefreshLinks_End
    Case Else:
    strMsg = "Informatie omtrent de opgetreden fout..." & vbCrLf & vbCrLf
    strMsg = strMsg & "Functie: fRefreshLinks" & vbCrLf
    strMsg = strMsg & "Omschrijving: " & Err.Description & vbCrLf
    strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
    MsgBox strMsg, vbOKOnly + vbCritical, "Fout"
    Resume fRefreshLinks_End
    End Select
    End Function

    Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
    Dim tdf As TableDef
    On Error Resume Next
    Set tdf = dbRemote.TableDefs(strTbl)
    fIsRemoteTable = (Err = 0)
    Set tdf = Nothing
    End Function

    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)
    Dim objFileDialog As FileDialog
    Set objFileDialog = FileDialog(msoFileDialogOpen)
    fGetMDBName = objFileDialog

    End Function

    Function fGetLinkedTables() As Collection
    'Returns all linked tables
    Dim collTables As New Collection
    Dim tdf As TableDef, db As Database
    Set db = CurrentDb
    db.TableDefs.Refresh
    For Each tdf In db.TableDefs
    With tdf
    If Len(.Connect) > 0 Then
    If Left$(.Connect, 4) = "ODBC" Then
    collTables.Add Item:=.Name & ";" & .Connect, Key:=.Name
    ' ODBC Reconnect handled separately
    Else
    collTables.Add Item:=.Name & .Connect, Key:=.Name
    End If
    End If
    End With
    Next
    Set fGetLinkedTables = collTables
    Set collTables = Nothing
    Set tdf = Nothing
    Set db = Nothing
    End Function

    Function fParsePath(strIn As String) As String
    If Left$(strIn, 4) <> "ODBC" Then
    fParsePath = Right(strIn, Len(strIn) _
    - (InStr(1, strIn, "DATABASE=") + 8))
    Else
    fParsePath = strIn
    End If
    End Function

    Function fParseTable(strIn As String) As String
    fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
    End Function

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Standard Windows File OpenSave dialog dont permit (MS access 2007)

    Did you add *.accdb to both strings in the instruction

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

    It might be easier to use Application.FileDialog instead of ahtCommonFileOpenSave which was a workaround for versions of Access before Access 2002 which didn't have a built-in file dialog.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •