如何为DoCmd.TransferText指定当前用户的桌面路径

嘿，这个问题很常见——硬编码用户路径确实会导致换账户就失效。咱们来改改代码，让它自动适配当前登录的用户：

方法1：使用系统环境变量（简单快捷） #

VBA里的Environ函数可以直接获取系统环境变量，其中USERPROFILE会返回当前用户的主目录（比如C:\Users\张三），咱们用它来拼接桌面路径就行：

Private Sub EthosRpt_Click()
    Dim desktopPath As String
    ' 动态获取当前用户的桌面路径
    desktopPath = Environ("USERPROFILE") & "\Desktop\EthosRpt.csv"
    
    DoCmd.OpenQuery "EthosSessions"
    DoCmd.TransferText acExportDelim, , "EthosSessions", desktopPath, True
End Sub

这种方法代码简洁，不需要额外引用，适合大多数默认桌面路径的场景。

方法2：使用FileSystemObject（更鲁棒） #

如果用户自定义了桌面位置（比如把桌面移到D盘），USERPROFILE拼接的路径就会出错。这时候用FileSystemObject的GetSpecialFolder方法可以准确获取系统定义的桌面路径，而且用后期绑定的话不需要手动添加引用：

Private Sub EthosRpt_Click()
    Dim fso As Object
    Dim desktopPath As String
    
    ' 创建FileSystemObject对象（后期绑定）
    Set fso = CreateObject("Scripting.FileSystemObject")
    ' GetSpecialFolder(0)代表系统桌面文件夹
    desktopPath = fso.GetSpecialFolder(0) & "\EthosRpt.csv"
    
    DoCmd.OpenQuery "EthosSessions"
    DoCmd.TransferText acExportDelim, , "EthosSessions", desktopPath, True
    
    ' 释放对象，避免内存泄漏
    Set fso = Nothing
End Sub

这种方法兼容性更强，能适配各种自定义的桌面路径设置。

你可以根据自己的需求选其中一种，两种方法都能让代码在任意用户账户下正常运行~

内容的提问来源于stack exchange，提问作者Ben H.