Я спрашивал:
1. как уговорить функцию DIR() показывать дерево папок, как Windows т.е. с Desktop-ом, ситевыми дисками и дисками на сервере. Честно искал на форумах, но ни чего не нашёл, ну или не понял что нашёл.
потом кое-что нашёл
Мужики, ну и дамы конечно, кое-что нашёл, по-крайней мере, меня устраивает. Пользуйтесь здесь может и вам пригодиться
Ну а теперь, ещё более интересный вариант (по-крайней мере для меня)
- Код: Выделить всё
Option Explicit
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)
Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
Private Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer ' Note alignment warning
fAnyOperationsAborted As Long
hNameMappings As Long
lpszProgressTitle As Long ' Alignment warning!!
End Type
Private Declare Function SHBrowseForFolder Lib "shell32.dll" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hWndOwner As Long, ByVal nFolder As Long, ListId As Long) As Long
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
Private Const MAX_PATH = 260
'----------------------------------------------
Private Sub Form_Load()
Const CSIDL_DESKTOP& = 0
Const BrowseForEverything& = &H4000
Text1.Text = BrowseFolders("Select a file or folder to copy", BrowseForEverything, CSIDL_DESKTOP)
End Sub
Private Function BrowseFolders(sMessage As String, Browse As Long, ByVal RootFolder As Long) As String
Dim Nullpos As Integer, lpIDList As Long, res As Long
Dim sPath As String, BInfo As BrowseInfo, RootID As Long
SHGetSpecialFolderLocation Me.hwnd, RootFolder, RootID
With BInfo
.hWndOwner = Me.hwnd
.lpszTitle = lstrcat(sMessage, "")
.ulFlags = Browse
.iImage = 0
.lParam = 0
.lpfnCallback = 0
.pIDLRoot = 0
.pszDisplayName = 0
End With
If RootID <> 0 Then BInfo.pIDLRoot = RootID
lpIDList = SHBrowseForFolder(BInfo)
If lpIDList <> 0 Then
sPath = String(MAX_PATH, 0)
res = SHGetPathFromIDList(lpIDList, sPath)
Call CoTaskMemFree(lpIDList)
Nullpos = InStr(sPath, vbNullChar)
If Nullpos <> 0 Then sPath = Left(sPath, Nullpos - 1)
End If
BrowseFolders = sPath
End Function
