在VBA中获取“我的文档”的目录路径

来源:互联网 发布:埃及艳后哪个版本 知乎 编辑:程序博客网 时间:2024/06/05 00:12

方法1. 读取注册表:

Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Global Const HKEY_CURRENT_USER = &H80000001
Global Const KEY_ALL_ACCESS = &H3F
Sub test()
Dim hKey As Long
Dim resultvl As String
lretval = RegOpenKeyEx(HKEY_CURRENT_USER, "Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders", 0, KEY_ALL_ACCESS, hKey)
If lretval = 0 Then
regop = RegQueryValueExNULL(hKey, "Personal", 0&, lType, 0&, lpcbData)
resultvl = String(lpcbData, 0)
regop = RegQueryValueExString(hKey, "Personal", 0&, lType, resultvl, lpcbData)
If regop = ERROR_NONE Then
vValue = Left$(resultvl, lpcbData)
Else
vValue = Empty
End If
Else
vValue = Empty
End If
MsgBox vValue
End Sub

方法2. 用WSCRIPT对象模型的SPECIALFOLDERS属性

Sub test()
        
         Set WSh = CreateObject("WScript.Shell")
         strdoc = WSh.SpecialFolders("Mydocuments")
         MsgBox strdoc    '这一句要不要都可以,已经在STRDOC中最得字串了
End Sub 

方法3. 使用shell对象.

Sub macro1()
MsgBox CreateObject("shell.Application").Namespace(5).self.Path
End Sub

方法4.

如果没有更改过我的文档路径,可以这样:

Sub macro1()
MsgBox Environ("USERPROFILE") & "/My Documents"

End Sub

方法5 使用WSCRIPT对象模型读取注册表

Sub getit()
MsgBox CreateObject("Wscript.Shell").RegRead("HKEY_CURRENT_USER/Software/Microsoft/Windows/CurrentVersion/Explorer/User Shell Folders/Personal")
End Sub

原创粉丝点击