Regnab wrote:
I'm looking for code that I can use to return the names of sub folders
which exist in a folder. The end goal is to be able to then use the
DIR(*) function to return the name of all files in each folder.
This is very old code. It does not reflect my current coding practices.
This morning I tested it as the temp sub shows. It seems to work OK.
News clients may insert line breaks which must be removed before the
code can be used. Using it with a base drive such as GetFolders("c:\")
which has many folders and sub folders may take a very long time. Other
newer simpler methods may exist and it's quite likely they will be
posted.
Function GetFolders(ByVal vStrRootFolder As String) As Variant
Dim aFolders() As Variant, strFolder As String, _
intFolder As Integer, intStart As Integer
If Right(vStrRootFolder, 1) <"\" Then vStrRootFolder =
vStrRootFolder & "\"
ReDim aFolders(intStart)
aFolders(intStart) = vStrRootFolder
Do
strFolder = Dir(aFolders(intStart), vbDirectory)
Do While strFolder <""
If strFolder <"." And strFolder <".." Then
strFolder = aFolders(intStart) & strFolder
If (GetAttr(strFolder) And vbDirectory) = vbDirectory
Then
intFolder = UBound(aFolders) + 1
If Right(strFolder, 1) <"\" Then strFolder =
strFolder & "\"
ReDim Preserve aFolders(LBound(aFolders) To
intFolder)
SysCmd acSysCmdSetStatus, "Locating Folders " &
strFolder
aFolders(intFolder) = strFolder
End If
End If
strFolder = Dir()
Loop
intStart = intStart + 1
Loop Until intStart UBound(aFolders)
GetPathExit:
GetFolders = aFolders
Erase aFolders
End Function
Sub temp()
Dim aFolders As Variant
Dim z As Long
aFolders = GetFolders("C:\Documents and Settings\Lyle Fairfield\My
Documents\Excel\")
For z = LBound(aFolders) To UBound(aFolders)
Debug.Print aFolders(z)
Next z
End Sub
