楼主
0Mouse |
Q：如何运用VBA获取“字体”文件夹所在路径呢？
A：可以采用以下4种方法获取。
方法1：WSH 引用
在VBE窗口依次单击“工具”-“引用”，勾选“Microsoft Shell Controls And Automation”项，单击“确定”按钮。- Sub xqoa1()
- Dim oShell As New Shell
- On Error Resume Next
- MsgBox oShell.Namespace(20).Self.Path '20对应于&H14&
- End Sub
方法2：WSH 后期绑定- Sub xqoa2()
- Dim WSH As Object
- Set WSH = CreateObject("Wscript.Shell")
- MsgBox WSH.SpecialFolders("Fonts")
- Set WSH = Nothing
- End Sub
方法3：Api函数- Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" _
- (ByVal hwndOwner As Long, ByVal nFolder As Integer, pidl As Long) As Long
- Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" _
- (ByVal pidl As Long, ByVal szPath As String) As Long
- Private Const ONTSCSIDL_F = &H14&
- Private Const MAX_PATH = 260
- Sub xqoa3()
- Dim pidl&, S$
- SHGetSpecialFolderLocation 0, ONTSCSIDL_F, pidl
- S = String(MAX_PATH, Chr(0))
- SHGetPathFromIDList pidl, S
- MsgBox Left(S, InStr(S, Chr(0)) - 1)
- End Sub
方法4：Api函数- Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" _
- (ByVal hkey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
- Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" _
- (ByVal hkey As Long, _
- ByVal lpValueName As String, _
- ByVal lpReserved As Long, _
- lpType As Long, _
- lpData As Any, _
- lpcbData As Long) As Long
- Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hkey As Long) As Long
- Private Const HKEY_CURRENT_USER = &H80000001
- Sub xqoa4()
- Dim hkey&, rst&, lenData&, typeData&, S$
- rst = RegOpenKey(HKEY_CURRENT_USER, "Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", hkey)
- If rst = 0 Then
- rst = RegQueryValueEx(hkey, "Fonts", 0, typeData, ByVal vbNullString, lenData)
- If rst = 0 Then
- S = String(lenData, Chr(0))
- RegQueryValueEx hkey, "Fonts", 0, typeData, ByVal S, lenData
- MsgBox Left(S, InStr(S, Chr(0)) - 1)
- End If
- RegCloseKey hkey
- End If
- End Sub
附件：
 运用VBA获取“字体”文件夹所在路径.rar
|
