northwolves[狼行天下] 的专栏

无知无惧,无欲无敌。

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

方法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

阅读更多
个人分类: API 其他技巧 VBA
想对作者说点什么? 我来说一句

没有更多推荐了,返回首页

不良信息举报

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

最多只允许输入30个字

加入CSDN,享受更精准的内容推荐,与500万程序员共同成长!
关闭
关闭