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

Question

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!

Answer 1

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