如何得到“桌面”、“我的文档”、“收藏夹”的目录？？？

粘贴到记事本，并保存为相应文件EXAMPLE13.VBP
====================================================================
Type=Exe
Form=Form1.frm
Module=Module1; Module1.bas
IconForm="Form1"
Startup="Form1"
HelpFile=""
ExeName32="example13.exe"
Command32=""
Name="工程1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="DudeWare"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
Module1.bas
====================================================================
Attribute VB_Name = "Module1"
Option Explicit
Type SHITEMID
    cb As Long
    abID As Byte
End Type

Type ITEMIDLIST
    mkid As SHITEMID
End Type

Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As LongPublic Const NOERROR = 0
Public Const CSIDL_DESKTOP = &H0
Public Const CSIDL_PROGRAMS = &H2
Public Const CSIDL_CONTROLS = &H3
Public Const CSIDL_PRINTERS = &H4
Public Const CSIDL_PERSONAL = &H5
Public Const CSIDL_FAVORITES = &H6
Public Const CSIDL_STARTUP = &H7
Public Const CSIDL_RECENT = &H8
Public Const CSIDL_SENDTO = &H9
Public Const CSIDL_BITBUCKET = &HA
Public Const CSIDL_STARTMENU = &HB
Public Const CSIDL_DESKTOPDIRECTORY = &H10
Public Const CSIDL_DRIVES = &H11
Public Const CSIDL_NETWORK = &H12
Public Const CSIDL_NETHOOD = &H13
Public Const CSIDL_FONTS = &H14
Public Const CSIDL_TEMPLATES = &H15

Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long 'ITEMIDLIST

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Const BIF_RETURNONLYFSDIRS = &H1
Public Const BIF_DONTGOBELOWDOMAIN = &H2
Public Const BIF_STATUSTEXT = &H4
Public Const BIF_RETURNFSANCESTORS = &H8
Public Const BIF_BROWSEFORCOMPUTER = &H1000
Public Const BIF_BROWSEFORPRINTER = &H2000

Form1.frm
====================================================================
VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "文件夹"
   ClientHeight    =   3825
   ClientLeft      =   1575
   ClientTop       =   1035
   ClientWidth     =   6915
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3825
   ScaleWidth      =   6915
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1
      Caption         =   "选项"
      Height          =   2955
      Left            =   180
      TabIndex        =   0
      Top             =   120
      Width           =   6615
      Begin VB.OptionButton Option1
         Caption         =   "文件夹"
         Height          =   315
         Index           =   0
         Left            =   180
         TabIndex        =   16
         Top             =   300
         Value           =   -1  'True
         Width           =   1800
      End
      Begin VB.TextBox Text1
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   1
         Left            =   2220
         Locked          =   -1  'True
         TabIndex        =   9
         Top             =   600
         Width           =   4200
      End
      Begin VB.TextBox Text1
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   14
         Left            =   2220
         Locked          =   -1  'True
         TabIndex        =   15
         Top             =   2460
         Width           =   4200
      End
      Begin VB.TextBox Text1
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   13
         Left            =   2220
         Locked          =   -1  'True
         TabIndex        =   14
         Top             =   2160
         Width           =   4200
      End
      Begin VB.TextBox Text1
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   11
         Left            =   2220
         Locked          =   -1  'True
         TabIndex        =   13
         Top             =   1800
         Width           =   4200
      End
      Begin VB.TextBox Text1
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   6
         Left            =   2220
         Locked          =   -1  'True
         TabIndex        =   12
         Top             =   1500
         Width           =   4200
      End
      Begin VB.TextBox Text1
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   5
         Left            =   2220
         Locked          =   -1  'True
         TabIndex        =   11
         Top             =   1200
         Width           =   4200
      End
      Begin VB.TextBox Text1
         BackColor       =   &H00C0C0C0&
         Height          =   285
         Index           =   2
         Left            =   2220
         Locked          =   -1  'True
         TabIndex        =   10
         Top             =   900
         Width           =   4200
      End
      Begin VB.OptionButton Option1
         Caption         =   "网上邻居"
         Height          =   315
         Index           =   14
         Left            =   180
         TabIndex        =   7
         Top             =   2460
         Width           =   2055
      End
      Begin VB.OptionButton Option1
         Caption         =   "我的电脑"
         Height          =   315
         Index           =   13
         Left            =   180
         TabIndex        =   6
         Top             =   2160
         Width           =   1800
      End
      Begin VB.OptionButton Option1
         Caption         =   "开始"
         Height          =   315
         Index           =   11
         Left            =   180
         TabIndex        =   5
         Top             =   1800
         Width           =   1800
      End
      Begin VB.OptionButton Option1
         Caption         =   "Favorites Folder"
         Height          =   315
         Index           =   6
         Left            =   180
         TabIndex        =   4
         Top             =   1500
         Width           =   1800
      End
      Begin VB.OptionButton Option1
         Caption         =   "我的文档"
         Height          =   315
         Index           =   5
         Left            =   180
         TabIndex        =   3
         Top             =   1200
         Width           =   1800
      End
      Begin VB.OptionButton Option1
         Caption         =   "程序文件夹"
         Height          =   315
         Index           =   2
         Left            =   180
         TabIndex        =   2
         Top             =   900
         Width           =   1800
      End
      Begin VB.OptionButton Option1
         Caption         =   "桌面文件夹"
         Height          =   315
         Index           =   1
         Left            =   180
         TabIndex        =   1
         Top             =   600
         Width           =   1800
      End
   End
   Begin VB.CommandButton Command1
      Caption         =   "浏览"
      Height          =   345
      Left            =   2400
      TabIndex        =   8
      Top             =   3360
      Width           =   1275
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim SFolder As String
Dim Selectoptin As StringPrivate Sub Form_Load()
    Dim idx&, item&
    Dim rtn&, path$
    Dim idl As ITEMIDLIST
    On Error Resume Next
    For idx& = 1 To 17
        '初始化各文件夹对应的值
        If idx& = 1 Then
            item& = 0
            '程序文件夹
        ElseIf idx& > 1 And idx& < 12 Then
            item& = idx&
            '桌面文件夹
        ElseIf idx& >= 12 Then
            item& = idx& + 4&
        End If
        '取得文件夹的路径
        rtn& = SHGetSpecialFolderLocation(Me.hWnd, item&, idl)
        If rtn& = NOERROR Then
            '显示文件夹的路径
            path$ = Space$(512)
            rtn& = SHGetPathFromIDList(ByVal idl.mkid.cb, ByVal path$)
            If rtn& Then Text1(idx&) = path$
        End If
    Next
    Selectoptin = 0
End SubPrivate Sub Option1_Click(Index As Integer)
    ' 选择的项目
    Selectoptin = Index
    If Index = 1 Then
        SFolder = 0
    ElseIf Index < 12 Then
        SFolder = Index
    Else
        SFolder = Index + 4
    End If
End SubPrivate Sub Command1_Click()
    Dim selectwin As BROWSEINFO
    Dim idl As ITEMIDLIST
    Dim rtn&, pidl&, path$, pos%
    selectwin.hOwner = Me.hWnd
    If Selectoptin Then
        rtn& = SHGetSpecialFolderLocation(ByVal Me.hWnd, ByVal SFolder, idl)
        selectwin.pidlRoot = idl.mkid.cb
    End If
    '显示选择的文件夹名称
    selectwin.lpszTitle = Option1(Selectoptin).Caption
    '设置文件夹类型
    selectwin.ulFlags = BIF_RETURNONLYFSDIRS
    '显示对话框
    pidl& = SHBrowseForFolder(selectwin)
    '显示选取的路径
    path$ = Space$(512)
    rtn& = SHGetPathFromIDList(ByVal pidl&, ByVal path$)
    If rtn& Then
        pos% = InStr(path$, Chr$(0))
        MsgBox "选择的文件夹为：" & Chr$(10) & Chr$(10) & Left(path$, pos - 1), vbInformation
    End If

End Sub

刚才的打错了，应当是
HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders
History是历史记录
Desktop是桌面
Personal是我的文档
Favorites是收藏夹
至于怎么读注册表，VB程序里面的
在你的VB安装目录下的Template\Code目录下
名叫"注册表访问.bas"注是中文版VB6.0

VB操作注册表：
http://www.sqreg.com/file/vb/reg_01.htm
http://www.sqreg.com/file/vb/reg_02.htm
http://www.sqreg.com/file/vb/reg_03.htm
http://www.sqreg.com/file/vb/reg_04.htm
http://www.sqreg.com/file/vb/reg_05.htm
http://www.sqreg.com/file/vb/reg_06.htm
http://www.sqreg.com/file/vb/reg_07.htm

好象Winnt系统不支持VB用API操作注册表，这是不是真的？？？

Private Sub Command1_Click()
    Dim Wshshell As Object
    Set Wshshell = CreateObject("WScript.Shell")
    MsgBox Wshshell.SpecialFolders("MyDocuments")
End Sub

Dim WS1 As Object
Set WS1 = CreateObject("WScript.Shell")
Debug.Print WS1.SpecialFolders("MyDocuments")
Debug.Print WS1.SpecialFolders("Desktop")
Debug.Print WS1.SpecialFolders("Favorites")

其实有个很简单的方法：用Environ（）获取

调试易

如何得到“桌面”、“我的文档”、“收藏夹”的目录？？？

解决方案 »