将链接的 table 文件路径更改为 VBA 中的 OS 用户名?

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

我已经在 Access 数据库中链接了 table。我想与其他用户共享此数据库和关联的 excel 工作簿。我想编写一个一次性使用的宏,用户将在他们第一次使用数据库时使用该宏将链接的 table 重新链接到新用户的本地文件夹。

例如:

链接的 table 当前正在从以下位置提取文件:
C:\Users\jane.doe\Desktop\Database Imports\Premier 账号List.xlsx

当新用户(假设他们的名字是 John Smith)重新链接 table 时,它需要读取: C:\Users\john.smith\Desktop\Database Imports\Premier 账号List.xlsx

我基本上想将文件路径从我的 OS 用户名更改为新用户的 OS 用户名。我已经有了提取 OS 用户名的代码,但我不确定如何编写更改文件路径的代码。这是提取 OS 用户名的代码:

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

我是 VBA/Access 的新手,所以如果您的回答尽可能具体,那就太好了。提前致谢!

TableDef 对象有一个您需要更改的连接 属性。这是一个 Read/Write 字符串。你只需要一些字符串操作来让它成为你想要的。请注意,如果他们将数据库文件移动到同一路径,您只需拉取 CurrentProject.Path 而不是使用用户名 API。

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