Directories and subdirectories

jag108

Active Member
Joined
May 14, 2002
Messages
433
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. MacOS
Hello All,

I need to have a working piece of VBA to look through a starting folder and collect information about all file and folders in hte "root" folder.

I need this to also keep going if therer are no files just folders.

At the moment the code I have works until it comes across a folder with just folders in it, then it assumes that there are no more directories with files/folders in.

Code:
Do Until temp_var = ""
        'Checks to see if temp_var is an empty string
        If temp_var <> "" Then
           'The following code will create an array of the directories
           If GetAttr(directory_text & temp_var) And vbDirectory And Mid$(temp_var, 1, 1) <> "." Then
                'enlarge the array to hold a new item
                ReDim Preserve dir_array(counter)
                'add directory to the array
                dir_array(counter) = directory_text & temp_var & "\"
                'Increase counter to make room for the next directory
                counter = counter + 1
                localcounter = localcounter + 1
           End If
        End If
        'Temp_var stores the individual Directory name
        temp_var = Dir()
    Loop

Thanks in advance for all help offered.
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
It gets worse!!!! :((

It seems as if the code I am using will only process certain folders no matter what, I am stumped as to why????

are numeric folders see or ingnored, what I mean by that is a folder named 2006 etc...
 
Upvote 0
Sorted... Thanks any way.

current = 0
dircount = 0
currentdir = startdir
While current <= dircount
subdirect = Dir(currentdir, vbDirectory + vbHidden)
While subdirect <> ""
If subdirect <> "." And subdirect <> ".." Then
If (GetAttr(currentdir & subdirect) And vbDirectory) = vbDirectory Then
dircount = dircount + 1
ReDim Preserve aryFoundDirectories(dircount)
aryFoundDirectories(dircount) = currentdir & subdirect & "\"
End If
End If
subdirect = Dir
Wend
current = current + 1
currentdir = aryFoundDirectories(current)
Wend
dircount = dircount + 1
ReDim Preserve aryFoundDirectories(dircount)
aryFoundDirectories(dircount) = startdir
 
Upvote 0
Sub mySelectFolderOnly()
'Select Folder.
Dim CurrentDriveNM$, myDrive$, myFolder$, filePath$


Application.DisplayAlerts = False
On Error GoTo myError

'Display Folder Shell, for you to select your Folder!
'(a,b,c,d)= b==> "Title"
'(a,b,c,d)= d==> 17=AllFilesDeskTop(MyComputer), 0=Root(DeskTop), 18=Network, 19=NetHood,
'23=Common(Programs), 2=Top(Programs), 38=All(Programs), 33=cookies, 16=DeskTop, 6=Favorites,
'5=MyDocuments, 4=Printers&Faxs, 27=PrintHood, 32=TempInterNet, 8=Recent,
'11=StartMenu, 7=StartUp(Only), 21=Templates, 36=Windows , 39=MyPictures,
'5=Personal(MyDocuments)

Set objFolder = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Select the Folder to use!", 0, 17)

If Not objFolder Is Nothing Then
If Len(objFolder.Items.Item.Path) > 3 Then
myFolder = objFolder.Items.Item.Path & Application.PathSeparator
Else
myFolder = objFolder.Items.Item.Path
End If
End If

'Cancel Dialog then Exit!
If myFolder = "" Then GoTo myEnd

'Hold your selected Folder!
ChDir myFolder
filePath = myFolder

'Work with selected folder.
MsgBox filePath

Exit Sub

'On error Display error information and help!
myError:

MsgBox "On ""OK"" will Exit you back to your sheet!" & vbCr & vbCr & _
"Error Source: " & Err.Source & vbCr & _
"Error Number: " & Err.Number & vbCr & _
"Error Type: " & Err.Description & vbCr _
, vbMsgBoxHelpButton _
, "Error Accessing, " & filePath & ", Drive: " & myDrive _
, Err.HelpFile _
, Err.HelpContext
GoTo myEnd

myEnd:
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,952
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top