Search code examples
ms-accessvbafilepathlinked-tables

Changing a linked table file path to OS username in VBA?


I have linked tables in an Access Database. I want to share this database and the associated excel workbooks with other users. I want to program a one-time use macro that the user will use the first time they use the database to relink the linked tables to the new user's local folder.

For example:

The linked table is current pulling the file from:
C:\Users\jane.doe\Desktop\Database Imports\Premier Account List.xlsx

When the new user (let's say their name is John Smith) relinks the table, it needs to read: C:\Users\john.smith\Desktop\Database Imports\Premier Account List.xlsx

I basically want to change the file path from my OS Username to new user's OS Username. I already have the code to pull the OS Username, but I'm not sure how to code changing the file path. Here is the code to pull the OS UserName:

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long

Function fOSUserName() As String

' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String

strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)

If (lngX > 0) Then
    fOSUserName = Left$(strUserName, lngLen - 1)
Else
    fOSUserName = vbNullString
End If

End Function

I am fairly new to VBA/Access, so if you could be as specific as possible with your answer, that would be great. Thanks in advanced!


Solution

  • The TableDef object has a Connect property that you need to change. It's a Read/Write String. You just need some string manipulation to make it how you want. Note that if they're moving the database file to the same path, you can just pull CurrentProject.Path rather than futzing with username APIs.

    Sub ChangeTableLink()
    
        Dim sNewPath As String
        Dim lDbaseStart As Long
        Dim td As TableDef
        Dim sFile As String
        Dim db As DAO.Database
    
        'This is what we look for in the Connect string
        Const sDBASE As String = "DATABASE="
    
        'Set a variable to CurrentDb and to the table
        Set db = CurrentDb
        Set td = db.TableDefs("Fuel Pricing")
    
        'Whatever your new path is, set it here
        sNewPath = CurrentProject.Path & "\"
    
        'Find where the database piece starts
        lDbaseStart = InStr(1, td.Connect, sDBASE)
    
        'As long as you found it
        If lDbaseStart > 0 Then
            'Separate out the file name
            sFile = Dir(Mid(td.Connect, lDbaseStart + Len(sDBASE), Len(td.Connect)))
    
            'Rewrite Connect and refresh it
            td.Connect = Left(td.Connect, lDbaseStart - 1) & sDBASE & sNewPath & sFile
            td.RefreshLink
        End If
    
    End Sub