Directories and subdirectories

jag108

Active Member
Joined
May 14, 2002
Messages
429
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.
 

Some videos you may like

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

jag108

Active Member
Joined
May 14, 2002
Messages
429
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. MacOS
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...
 

jag108

Active Member
Joined
May 14, 2002
Messages
429
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
  2. MacOS
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
 

Joe Was

MrExcel MVP
Joined
Feb 19, 2002
Messages
7,539
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
 

Watch MrExcel Video

Forum statistics

Threads
1,113,811
Messages
5,544,451
Members
410,612
Latest member
MrACED
Top