Здравствуйте, уважаемые программисты. Помогите разобраться с проблемой.
У меня есть макрос - загрузки случайной картинки в активX Image из папки "Картинки" которая находится в одной папке с файлом. Событие - нажатие на кнопку.
Но есть один недостаток - макрос видит фотофайлы - только в папке "Картинки" (если они лежат не в подпапках) - и не видит фотофайлы в подпапках папки "Картинки".
Как заставить макрос - также случайно загружать картинки - не только те, что лежат в папке "Картинки" (не в подпапках), а еще и те которые лежат - в каких-либо подпапках - этой папки?
Здравствуйте, уважаемые программисты. Помогите разобраться с проблемой.
У меня есть макрос - загрузки случайной картинки в активX Image из папки "Картинки" которая находится в одной папке с файлом. Событие - нажатие на кнопку.
Но есть один недостаток - макрос видит фотофайлы - только в папке "Картинки" (если они лежат не в подпапках) - и не видит фотофайлы в подпапках папки "Картинки".
Как заставить макрос - также случайно загружать картинки - не только те, что лежат в папке "Картинки" (не в подпапках), а еще и те которые лежат - в каких-либо подпапках - этой папки?Grell
Private Sub GetFolders(strParentFolder As String, colFolders As Collection)
Dim strFolderName As String Dim col As New Collection, i As Long
strFolderName = Dir(strParentFolder & "\", vbDirectory) Do While strFolderName <> "" If (GetAttr(strParentFolder & "\" & strFolderName) And vbDirectory) <> 0 Then If strFolderName <> "." And strFolderName <> ".." Then col.Add Item:=strParentFolder & "\" & strFolderName End If End If strFolderName = Dir Loop
For i = 1 To col.Count colFolders.Add Item:=col(i) Next i
For i = 1 To col.Count Call GetFolders(col(i), colFolders) Next i
End Sub
Private Sub GetFiles(strFolderName As String, colFiles As Collection) Dim strFileName As String strFileName = Dir(strFolderName & "\") Do While strFileName <> "" colFiles.Add Item:=strFolderName & "\" & strFileName strFileName = Dir Loop End Sub
[/vba]
[vba]
Код
Sub Выбрать_картинку()
Dim colFolders As New Collection, colFiles As New Collection Dim lngRnd As Long, i As Long
Private Sub GetFolders(strParentFolder As String, colFolders As Collection)
Dim strFolderName As String Dim col As New Collection, i As Long
strFolderName = Dir(strParentFolder & "\", vbDirectory) Do While strFolderName <> "" If (GetAttr(strParentFolder & "\" & strFolderName) And vbDirectory) <> 0 Then If strFolderName <> "." And strFolderName <> ".." Then col.Add Item:=strParentFolder & "\" & strFolderName End If End If strFolderName = Dir Loop
For i = 1 To col.Count colFolders.Add Item:=col(i) Next i
For i = 1 To col.Count Call GetFolders(col(i), colFolders) Next i
End Sub
Private Sub GetFiles(strFolderName As String, colFiles As Collection) Dim strFileName As String strFileName = Dir(strFolderName & "\") Do While strFileName <> "" colFiles.Add Item:=strFolderName & "\" & strFileName strFileName = Dir Loop End Sub