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

Question

这就是我所拥有的：

Private Sub EthosRpt_Click()

    DoCmd.OpenQuery "EthosSessions"

    DoCmd.TransferText acExportDelim, , "EthosSessions", "C:\Users\JDoe\Desktop\EthosRpt.csv", True

End Sub

它适用于我的用户帐户（我的用户帐户= JDoe）。如何让它适用于任何当前用户？

Answer 1

尝试“％USERPROFILE％\ Desktop \ EthosRpt.csv”

像： DoCmd.TransferText acExportDelim ,,“EthosSessions”，“％USERPROFILE％\ Desktop \ EthosRpt.csv”，True

Answer 2

首先获取用户名作为字符串并替换用户名

Dim strDisplayName as string
Set objAD = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objAD.UserName)
strDisplayName = objUser.DisplayName

大于

DoCmd.TransferText acExportDelim, , 
"EthosSessions","C:\Users\" & strDisplayName & "\Desktop\EthosRpt.csv", True

Answer 3

尝试：

Private Sub EthosRpt_Click()

    Dim FileName As String

    DoCmd.OpenQuery "EthosSessions"

    FileName =  Environ("UserProfile") & "\Desktop\EthosRpt.csv"
    DoCmd.TransferText acExportDelim, , "EthosSessions", FileName, True

End Sub