'СОРС за ФОРМАТА

Private Sub Form_Load()

'Запълване на Listbox с константи

For j = 1 To 60

List1.AddItem j

Next j

End Sub

Private Sub List1_Click()

'Преобразуване на посочената константа в Път

specfolder = GetSpecialFolder(List1.Text)

Text1.Text = specfolder

End Sub

Private Sub Command1_Click()

'Отваряне на избраната директория

Set objShell = CreateObject("Shell.Application") '

objShell.ShellExecute "explorer.exe", Text1.Text, "", "", 10 '

End Sub

Private Sub Command2_Click()

'Отваряне на My Documents

Set objShell = CreateObject("Shell.Application") '

objShell.ShellExecute "explorer.exe", GetSpecialFolder(5), "", "", 10 '

End Sub

'СОРС за МОДУЛА SpecialFolder.bas

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

Public Function GetSpecialFolder(ByVal lCSIDL As Long) As String

Const S_OK As Long = 0

Const MAX_PATH As Long = 260

Dim sPath As String

Dim lIdl As Long

If SHGetSpecialFolderLocation(0, lCSIDL, lIdl) = S_OK Then

sPath = Space$(MAX_PATH)

If SHGetPathFromIDList(lIdl, sPath) Then

CoTaskMemFree lIdl

GetSpecialFolder = Left$(sPath, InStr(sPath, vbNullChar) - 1)

End If

End If

End Function