Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations TouchToneTommy on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Changing linked table properties

Status
Not open for further replies.

MitchJP

MIS
Feb 17, 2004
43
US
I have a linked table that is sourced from another access DB on a different network drive. Under the table properties it is linked using the drive letter that I have mapped.

When other users try to access the table, it errors out because they have the network drive mapped using a different letter.

I tried to change the properties so that it references the server/share name, but it won't allow me to. Is there any way to change this? Otherwise I'll have to have all of the users remap their shared drives (which I don't want to do).

Thanks!
MitchJP
 
I tried to change the properties so that it references the server/share name, but it won't allow me to"
This is not an Access issue. Access will let you use UNC paths. It must be something to do with your permissions.
 
You should use the linked table manager or code to change the connection property to point to the server/share. You can't do this in the table properties since this is read-only.

Duane MS Access MVP
[green]Ask a great question, get a great answer.[/green] [red]Ask a vague question, get a vague answer.[/red]
[green]Find out how to get great answers faq219-2884.[/green]
 
The following is a from Bill Powers who used to have a web site with some sample databases. Bill is / was a "super" Tek-Tip'ster and had used this post for others with the similar problem.

Code:
Option Explicit
Option Compare Database

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
    "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
    "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Boolean

Declare Function FindWindow Lib "user32" Alias _
    "FindWindowA" (ByVal lpClassName As String, _
                    ByVal lpWindowName As Long) As Long

Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
                    ByVal wParam As Long, _
                    ByVal lParam As Long) As Long

Type MSA_OPENFILENAME
    strFilter As String
    lngFilterIndex As Long
    strInitialDir As String
    strInitialFile As String
    strDialogTitle As String
    strDefaultExtension As String
    lngFlags As Long
    strFullPathReturned As String
    strFileNameReturned As String
    intFileOffset As Integer
    intFileExtension As Integer
End Type

Const ALLFILES = "All Files"

Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As Long
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As Long
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
    Dim strFilter As String
    Dim intRet As Integer
    Dim intNum As Integer
    intNum = UBound(varFilt)
    If (intNum <> -1) Then
        For intRet = 0 To intNum
            strFilter = strFilter & varFilt(intRet) & vbNullChar
        Next
        If intNum Mod 2 = 0 Then
            strFilter = strFilter & "*.*" & vbNullChar
        End If
        strFilter = strFilter & vbNullChar
    Else
        strFilter = ""
    End If
    MSA_CreateFilterString = strFilter
End Function

Function MSA_ConvertFilterString(strFilterIn As String) As String
    Dim strFilter As String
    Dim intNum As Integer, intPos As Integer, intLastPos As Integer
    strFilter = ""
    intNum = 0
    intPos = 1
    intLastPos = 1
    Do
        intPos = InStr(intLastPos, strFilterIn, "|")
        If (intPos > intLastPos) Then
            strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos) & vbNullChar
            intNum = intNum + 1
            intLastPos = intPos + 1
        ElseIf (intPos = intLastPos) Then
            intLastPos = intPos + 1
        End If
    Loop Until (intPos = 0)
    intPos = Len(strFilterIn)
    If (intPos >= intLastPos) Then
        strFilter = strFilter & Mid(strFilterIn, intLastPos, intPos - intLastPos + 1) & vbNullChar
        intNum = intNum + 1
    End If
    If intNum Mod 2 = 1 Then
        strFilter = strFilter & "*.*" & vbNullChar
    End If
    If strFilter <> "" Then
        strFilter = strFilter & vbNullChar
    End If
    MSA_ConvertFilterString = strFilter
End Function

Private Function MSA_GetSaveFileName(msaof As MSA_OPENFILENAME) As Integer
    Dim of As OPENFILENAME
    Dim intRet As Integer
    MSAOF_to_OF msaof, of
    of.flags = of.flags Or OFN_HIDEREADONLY
    intRet = GetSaveFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetSaveFileName = intRet
End Function

Function MSA_SimpleGetSaveFileName() As String
    Dim msaof As MSA_OPENFILENAME
    Dim intRet As Integer
    Dim strRet As String
    intRet = MSA_GetSaveFileName(msaof)
    If intRet Then
        strRet = msaof.strFullPathReturned
    End If
    MSA_SimpleGetSaveFileName = strRet
End Function

Private Function MSA_GetOpenFileName(msaof As MSA_OPENFILENAME) As Integer
    Dim of As OPENFILENAME
    Dim intRet As Integer
    MSAOF_to_OF msaof, of
    intRet = GetOpenFileName(of)
    If intRet Then
        OF_to_MSAOF of, msaof
    End If
    MSA_GetOpenFileName = intRet
End Function

Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
    msaof.strFullPathReturned = Left(of.lpstrFile, InStr(of.lpstrFile, vbNullChar) - 1)
    msaof.strFileNameReturned = of.lpstrFileTitle
    msaof.intFileOffset = of.nFileOffset
    msaof.intFileExtension = of.nFileExtension
End Sub

Private Sub MSAOF_to_OF(msaof As MSA_OPENFILENAME, of As OPENFILENAME)
    Dim strFile As String * 512
    of.hwndOwner = Application.hWndAccessApp
    of.hInstance = 0
    of.lpstrCustomFilter = 0
    of.nMaxCustrFilter = 0
    of.lpfnHook = 0
    of.lpTemplateName = 0
    of.lCustrData = 0
    If msaof.strFilter = "" Then
        of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
    Else
        of.lpstrFilter = msaof.strFilter
    End If
    of.nFilterIndex = msaof.lngFilterIndex
    of.lpstrFile = msaof.strInitialFile _
        & String(512 - Len(msaof.strInitialFile), 0)
    of.nMaxFile = 511
    of.lpstrFileTitle = String(512, 0)
    of.nMaxFileTitle = 511
    of.lpstrTitle = msaof.strDialogTitle
    of.lpstrInitialDir = msaof.strInitialDir
    of.lpstrDefExt = msaof.strDefaultExtension
    of.flags = msaof.lngFlags
    of.lStructSize = Len(of)
End Sub

Public Function RelinkTables() As Boolean
On Error Resume Next
Const conNonExistentTable = 3011
Const conNotconEEC3Data = 3078
Const conEEC3DataNotFound = 3024
Const conAccessDenied = 3051
Const conReadOnlyDatabase = 3027
Const conNotValidPath = 3044
Const conDiskNetworkError = 3043
Const conAppTitle = "YourDatabaseName"   'edit this
Dim strSearchPath As String
Dim strFileName As String
Dim strError As String
Dim strDatabase As String
Dim frm_ActiveForm As Form
Dim msg As String
Set frm_ActiveForm = Screen.ActiveForm
    strDatabase = "Biblio.mdb"  'type in the name of the DB to link to
    strSearchPath = "C:\My Documents\"   'type in the default search directory
    Err.Clear
Err_strSearchPath:
    If (Dir(strSearchPath & strDatabase) <> "") Then
        strFileName = strSearchPath & strDatabase
    Else
        msg = "Couldn't find shared data for " & conAppTitle & " ."
        msg = msg & "You must locate " & strDatabase & "."
        msg = msg & " Are you connected to the Network?"
        MsgBox msg, vbInformation, "Refresh Links"
        strFileName = FindSharedData(strSearchPath)
        If strFileName = "" Then
            strError = "Sorry, you must locate " & strDatabase & " to open " & conAppTitle & "."
            GoTo Exit_Failed
        End If
    End If
    frm_ActiveForm.Repaint
     If RefreshLinks(strFileName) Then
        RelinkTables = True
        Exit Function
    End If
    If Err = conNotValidPath Or Err = conDiskNetworkError Or Err = conEEC3DataNotFound Then
        strSearchPath = "S:\"    ' type in what you want to be an alternative search direcory
        GoTo Err_strSearchPath
    End If
    Select Case Err
    Case conNonExistentTable, conNotconEEC3Data
        strError = "File '" & strFileName & "' does not contain the required " & strDatabase & " ."
    Case Err = conEEC3DataNotFound
        strError = "You can't run " & conAppTitle & " until you locate " & strDatabase & " ."
    Case Err = conAccessDenied
        strError = "Couldn't open " & strFileName & " because it is read-only or located on a read-only share."
    Case Err = conReadOnlyDatabase
        strError = "Can't reattach tables because " & conAppTitle & " is read-only or is located on a read-only share."
    Case Else
        strError = Err.Description
    End Select
Exit_Failed:
    MsgBox "Table Links Error", vbCritical, conAppTitle
    RelinkTables = False
End Function

Function FindSharedData(strSearchPath) As String
On Error Resume Next
Dim msaof As MSA_OPENFILENAME
    msaof.strDialogTitle = "Where is the file named Biblio.mdb?"  'edit this to you Back End DB name
    msaof.strInitialDir = strSearchPath
    msaof.strFilter = MSA_CreateFilterString("Access Databases", "*.mdb;*.mde")
    MSA_GetOpenFileName msaof
    FindSharedData = Trim(msaof.strFullPathReturned)
End Function

Function MSA_SimpleGetOpenFileName() As String
On Error Resume Next
Dim msaof As MSA_OPENFILENAME
Dim intRet As Integer
Dim strRet As String
    intRet = MSA_GetOpenFileName(msaof)
    If intRet Then
        strRet = msaof.strFullPathReturned
    End If
    MSA_SimpleGetOpenFileName = strRet
End Function

Public Function CheckLinks() As Boolean
On Error Resume Next
Dim dbs As Database, rst As Recordset
Set dbs = CurrentDb()
Set rst = dbs.OpenRecordset("Titles")  'type in a linked table name here
    If Err = 0 Then
        CheckLinks = True
    Else
        CheckLinks = False
    End If
End Function

Private Sub OF_to_MSAOF1(of As OPENFILENAME, msaof As MSA_OPENFILENAME)
On Error Resume Next
    msaof.strFullPathReturned = Left$(of.lpstrFile, InStr(of.lpstrFile, Chr$(0)))
    msaof.strFileNameReturned = of.lpstrFileTitle
    msaof.intFileOffset = of.nFileOffset
    msaof.intFileExtension = of.nFileExtension
End Sub

Private Function RefreshLinks(strFileName As String) As Boolean
On Error Resume Next
Dim dbs, dbsRefresh As Database
Dim intCount As Integer
Dim tdf As TableDef
    Set dbsRefresh = OpenDatabase(strFileName, False, False, "; pwd=") 'edit this if db is passworded (pwd=1234)
    Set dbs = CurrentDb()
    For intCount = 0 To dbs.TableDefs.Count - 1
        Set tdf = dbs.TableDefs(intCount)
        If Len(tdf.Connect) > 0 Then
            tdf.Connect = ";DATABASE=" & strFileName
            Err = 0
            On Error Resume Next
            tdf.RefreshLink
            If Err <> 0 Then
                RefreshLinks = False
                Exit Function
            End If
        End If
    Next intCount
    dbsRefresh.Close
    DoCmd.OpenForm "Login" 'edit this to your "Switchboard" or startup form.
    DoCmd.Echo True, ""
    RefreshLinks = True
End Function
[COLOR=blue]
Function Autoexec()[/color]
On Error Resume Next
    If CheckLinks() = False Then
        If RelinkTables() = False Then
            DoCmd.Quit acExit
        End If
    End If
End Function

This code is inserted in a module. The key is the Autoexec function which is fired off by default open (login) screen for the form Open event procedure.

If the desired database is not found, then the Windows navigation window pops up and allows the end user to navigate to the relavent location.

Also,
You can store the various link data in a table, and then go through a process of checking each link until it is successful...

If NotFound h:\..\ Then
If NotFound i:\..\ Then
etc...

Richard
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top