Ms access 在VBA中将链接表文件路径更改为OS用户名？

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

例如：

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

当新用户（假设他们的名字是John Smith）重新链接该表时，需要读取： C:\Users\john.smith\Desktop\Database Imports\Premier Account List.xlsx

我基本上希望将文件路径从我的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对象有一个需要更改的Connect属性。它是一个读/写字符串。您只需要对字符串进行一些操作就可以了。请注意，如果他们将数据库文件移动到同一路径，您只需拉取

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

---

TableDef对象具有需要更改的Connect属性。它是一个读/写字符串。您只需要对字符串进行一些操作就可以了。请注意，如果他们将数据库文件移动到同一路径，您只需拉取

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

---

您是否可以只设置filepath=“C:\Users\”&username&“\Desktop…”您是否可以只设置filepath=“C:\Users\”&username&“\Desktop…”