获得windows常用文件夹路径

dim strName as string

strName=GetSysDirPath(CSIDL_PERSONAL) 

上面的代码就获得你要的目录，但是你要复制下方的代码到一个模块中，具体如下：

Option Explicit
'SHGetSpecialFolderLocation获得某一个特殊的目录的位置,如果函数调用成功返回NOERROR
'或者一个OLE错误
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
    (ByVal hwndOwner As Long, _
    ByVal nFolder As SHSpecialFolderIDs, _
    pidl As Long) As Long


'SHGetPathFromIDList函数将一个Item转换为文件路径
Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
    (ByVal pidl As Long, _
    ByVal pszPath As String) As Long

'SHGetFileInfoPidl函数获得某个文件对象的信息。
Declare Function SHGetFileInfoPidl Lib "shell32" Alias "SHGetFileInfoA" _
    (ByVal pidl As Long, _
    ByVal dwFileAttributes As Long, _
    psfib As SHFILEINFOBYTE, _
    ByVal cbFileInfo As Long, _
    ByVal uFlags As SHGFI_flags) As Long


Public Const MAX_PATH = 260
Public Const NOERROR = 0


Public Enum SHSpecialFolderIDs '列出所有Windows下特殊文件夹的ID
    CSIDL_DESKTOP = &H0         '桌面
    CSIDL_INTERNET = &H1
    CSIDL_PROGRAMS = &H2        '程序
    CSIDL_CONTROLS = &H3
    CSIDL_PRINTERS = &H4
    CSIDL_PERSONAL = &H5        '我的文档
    CSIDL_FAVORITES = &H6
    CSIDL_STARTUP = &H7         '开始
    CSIDL_RECENT = &H8
    CSIDL_SENDTO = &H9
    CSIDL_BITBUCKET = &HA
    CSIDL_STARTMENU = &HB
    CSIDL_DESKTOPDIRECTORY = &H10
    CSIDL_DRIVES = &H11
    CSIDL_NETWORK = &H12
    CSIDL_NETHOOD = &H13        '网上邻居
    CSIDL_FONTS = &H14
    CSIDL_TEMPLATES = &H15
    CSIDL_COMMON_STARTMENU = &H16
    CSIDL_COMMON_PROGRAMS = &H17
    CSIDL_COMMON_STARTUP = &H18
    CSIDL_COMMON_DESKTOPDIRECTORY = &H19
    CSIDL_APPDATA = &H1A
    CSIDL_PRINTHOOD = &H1B
    CSIDL_ALTSTARTUP = &H1D
    CSIDL_COMMON_ALTSTARTUP = &H1E
    CSIDL_COMMON_FAVORITES = &H1F
    CSIDL_INTERNET_CACHE = &H20
    CSIDL_COOKIES = &H21
    CSIDL_HISTORY = &H22            '历史文件夹
End Enum

Enum SHGFI_flags
    SHGFI_LARGEICON = &H0
    SHGFI_SMALLICON = &H1
    SHGFI_OPENICON = &H2
    SHGFI_SHELLICONSIZE = &H4
    SHGFI_PIDL = &H8
    SHGFI_USEFILEATTRIBUTES = &H10
    SHGFI_ICON = &H100
    SHGFI_DISPLAYNAME = &H200
    SHGFI_TYPENAME = &H400
    SHGFI_ATTRIBUTES = &H800
    SHGFI_ICONLOCATION = &H1000
    SHGFI_EXETYPE = &H2000
    SHGFI_SYSICONINDEX = &H4000
    SHGFI_LINKOVERLAY = &H8000
    SHGFI_SELECTED = &H10000
End Enum



Public Type SHFILEINFOBYTE
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName(1 To MAX_PATH) As Byte
    szTypeName(1 To 80) As Byte
End Type

Declare Function SHGetFileInfo Lib "shell32" Alias "SHGetFileInfoA" _
    (ByVal pszPath As String, _
    ByVal dwFileAttributes As Long, _
    psfi As SHFILEINFO, _
    ByVal cbFileInfo As Long, _
    ByVal uFlags As SHGFI_flags) As Long

Public Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type



'根据一个特定文件夹对象的ID获得它的目录pidl
Public Function GetPIDLFromFolderID(hOwner As Long, nFolder As SHSpecialFolderIDs) As Long
    Dim pidl As Long
    If SHGetSpecialFolderLocation(hOwner, nFolder, pidl) = NOERROR Then
        GetPIDLFromFolderID = pidl
    End If
End Function

'获取文件夹名称
Public Function GetDisplayNameFromPIDL(pidl As Long) As String
    Dim sfib As SHFILEINFOBYTE
    If SHGetFileInfoPidl(pidl, 0, sfib, Len(sfib), SHGFI_PIDL Or SHGFI_DISPLAYNAME) Then
        GetDisplayNameFromPIDL = GetStrFromBufferA(StrConv(sfib.szDisplayName, vbUnicode))
    End If
End Function

'获取路径
Public Function GetPathFromPIDL(pidl As Long) As String
    Dim sPath As String * MAX_PATH
    If SHGetPathFromIDList(pidl, sPath) Then
        GetPathFromPIDL = GetStrFromBufferA(sPath)
    End If
End Function

'获取字符串
Public Function GetStrFromBufferA(sz As String) As String
    If InStr(sz, vbNullChar) Then
        GetStrFromBufferA = Left$(sz, InStr(sz, vbNullChar) - 1)
    Else
        GetStrFromBufferA = sz
    End If
End Function

'整合以上函数,得到全路径
Public Function GetSysDirPath(DirType As SHSpecialFolderIDs) As String
    Dim pid As Long
    Dim name As String
    pid = GetPIDLFromFolderID(0, CSIDL_PERSONAL)
    name = GetPathFromPIDL(pid)
    GetSysDirPath = name & GetDisplayNameFromPIDL(pid)
End Function