Microsoft Office Tutorials and References
In Depth Information
Creating a Folder Tree Menu
' * * * * *¶
'Get all files and folders in the specified path¶
'and return them in an array¶
Function GetMenuEntries(path As String) As Variant¶
'Variable declaration¶
Dim folderContent As String¶
Dim filePath As String¶
Dim aEntries() As String¶
Dim iFileEntry As Long¶
Dim iDirEntry As Long¶
'Store the type (file or directory) and¶
'name in an array, to pass back¶
'The array has two dimensions¶
'All entries with 0 in the first dimension¶
'are file names; all entries with 1¶
'in the first dimension are folders¶
ReDim aEntries(1, 0)¶
'Start processing the folder tree in the base path...¶
folderContent = Dir(path, vbDirectory + vbNormal)¶
'Looping through each entry in the folder¶
'until no more are found¶
Do While folderContent <> ""¶
filePath = path & folderContent¶
'Determine which kind of entry is being dealt with¶
Select Case GetAttr(filePath)¶
Case vbArchive, vbNormal¶
'Only increment the second array dimension¶
'as necessary¶
If iFileEntry >= iDirEntry Then¶
ReDim Preserve aEntries(1, iFileEntry)¶
End If¶
'add file to the appropriate array dimension¶
aEntries(0, iFileEntry) = folderContent¶
'increment the counter for this type¶
iFileEntry = iFileEntry + 1¶
Case vbDirectory¶
'Don't pick up the folder itself,¶
'nor its "parent"¶
If folderContent <> "." And folderContent <> ".." Then¶
'Only increment the second array dimension¶
'as necessary¶
If iDirEntry >= iFileEntry Then¶
ReDim Preserve aEntries(1, iDirEntry)¶
End If¶
aEntries(1, iDirEntry) = folderContent¶
iDirEntry = iDirEntry + 1¶
End If¶
Case Else¶
End Select¶
Search JabSto ::

Custom Search