имееться у меня такой код, выбираем папку, и поучаем всё её дочерние папки и файлы
у меня вопрос о том сталкивался ли кто с такой задачей и почему я не могу ничего получить если я папку вот только создал на рабочем столе и не возращает ничего. вообще ничего
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_DONTGOBELOWDOMAIN = 2
Const MAX_PATH = 260
Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpbi As BrowseInfo ) As Long
Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" ( Byval pidList As Long, Byval lpBuffer As String ) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( Byval lpClassName As Any, Byval lpWindowName As Any ) As Long
Sub Click(Source As Button)
Dim pathFolder As String
Dim fileName As String
Const mask = "\*.*"
pathFolder = ChooseFolder()
Dim pathName As String
pathName = pathFolder
Dim FolderArray() As Variant ' The Array with all folders
Dim FolderCounter As Long ' The FolderCounter
FolderCounter = 0
' Print "FileFunction [Start]---------------------------------------------------"
'fileName = Dir$(pathName+"\*.*",16) если вы хотите получить к примеру только папки, иерархию папок
fileName = Dir$(pathName+"\*.*")
Do While fileName <> ""
If Getfileattr(pathName+"\"+fileName) = 16 And Not filename = "." And Not filename = ".." Then
Redim Preserve FolderArray(FolderCounter)
' if we have a folder in the fileName Var. then add it to the array
' Print pathName+"\"+fileName
Msgbox pathName+"\"+fileName
FolderArray(FolderCounter) = pathName+"\"+fileName
FolderCounter = FolderCounter +1
End If
fileName = Dir$()
Loop
' Print "FileFunction [Ende]---------------------------------------------------"
End Sub
Function ChooseFolder ( ) As String
Dim lpIDList As Long
Dim sBuffer As String * 255
Dim sReturnVal As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
sBuffer = String ( Len ( sBuffer ) , Chr(0) )
szTitle = "Выберите папку:"
tBrowseInfo.hWndOwner = FindWindow ( "notes", &H0 )
tBrowseInfo.lpszTitle = szTitle
tBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
lpIDList = SHBrowseForFolder ( tBrowseInfo )
If ( lpIDList ) Then
SHGetPathFromIDList lpIDList, sBuffer
ChooseFolder = Left ( sBuffer, Instr ( sBuffer, Chr(0) ) - 1) 'путь выбраноко каталога
End If
End Function
у меня вопрос о том сталкивался ли кто с такой задачей и почему я не могу ничего получить если я папку вот только создал на рабочем столе и не возращает ничего. вообще ничего
Const BIF_RETURNONLYFSDIRS = 1
Const BIF_DONTGOBELOWDOMAIN = 2
Const MAX_PATH = 260
Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As String
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
Declare Function SHBrowseForFolder Lib "shell32" Alias "SHBrowseForFolderA" (lpbi As BrowseInfo ) As Long
Declare Function SHGetPathFromIDList Lib "shell32" Alias "SHGetPathFromIDListA" ( Byval pidList As Long, Byval lpBuffer As String ) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( Byval lpClassName As Any, Byval lpWindowName As Any ) As Long
Sub Click(Source As Button)
Dim pathFolder As String
Dim fileName As String
Const mask = "\*.*"
pathFolder = ChooseFolder()
Dim pathName As String
pathName = pathFolder
Dim FolderArray() As Variant ' The Array with all folders
Dim FolderCounter As Long ' The FolderCounter
FolderCounter = 0
' Print "FileFunction [Start]---------------------------------------------------"
'fileName = Dir$(pathName+"\*.*",16) если вы хотите получить к примеру только папки, иерархию папок
fileName = Dir$(pathName+"\*.*")
Do While fileName <> ""
If Getfileattr(pathName+"\"+fileName) = 16 And Not filename = "." And Not filename = ".." Then
Redim Preserve FolderArray(FolderCounter)
' if we have a folder in the fileName Var. then add it to the array
' Print pathName+"\"+fileName
Msgbox pathName+"\"+fileName
FolderArray(FolderCounter) = pathName+"\"+fileName
FolderCounter = FolderCounter +1
End If
fileName = Dir$()
Loop
' Print "FileFunction [Ende]---------------------------------------------------"
End Sub
Function ChooseFolder ( ) As String
Dim lpIDList As Long
Dim sBuffer As String * 255
Dim sReturnVal As String
Dim szTitle As String
Dim tBrowseInfo As BrowseInfo
sBuffer = String ( Len ( sBuffer ) , Chr(0) )
szTitle = "Выберите папку:"
tBrowseInfo.hWndOwner = FindWindow ( "notes", &H0 )
tBrowseInfo.lpszTitle = szTitle
tBrowseInfo.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
lpIDList = SHBrowseForFolder ( tBrowseInfo )
If ( lpIDList ) Then
SHGetPathFromIDList lpIDList, sBuffer
ChooseFolder = Left ( sBuffer, Instr ( sBuffer, Chr(0) ) - 1) 'путь выбраноко каталога
End If
End Function
