sub directories again

  • Thread starter Thread starter Mike
  • Start date Start date
M

Mike

Hello, I thought I should repost my question because the
message string was getting old so...

how can I
input a directory like "C:\Documents and Settings\" to a
program then have a program list (or output to a file) the
subdirectories?

Thanks in advanced
 
Mike,

Here is one way. It outputs the directories to a worksheet, indented as to
their levels

Dim FSO As Object
Dim cnt As Long
Dim level As Long
Dim arFiles

Sub Folders()
Dim i As Long

Set FSO = CreateObject("Scripting.FileSystemObject")

arFiles = Array()
cnt = 0
level = 1

ReDim arFiles(1, 0)
arFiles(0, 0) = "C:\myTest"
arFiles(1, 0) = level
SelectFiles "C:\myTest"

cnt = 0
For i = LBound(arFiles, 2) To UBound(arFiles, 2)
ActiveSheet.Cells(i + 1, arFiles(1, i)).Value = arFiles(0, i)
Next

End Sub

'---------------------------------------------------------------------------
----
Sub SelectFiles(sPath)
'---------------------------------------------------------------------------
----
Dim fldr As Object
Dim Folder As Object

Set Folder = FSO.Getfolder(sPath)
level = level + 1
For Each fldr In Folder.Subfolders
cnt = cnt + 1
ReDim Preserve arFiles(1, cnt)
arFiles(0, cnt) = fldr.Name
arFiles(1, cnt) = level
SelectFiles fldr.Path
level = level - 1
Next

End Sub

'---------------------------------
end-script ---------------------------------




--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Thanks for the help. I modified the origional suggestions
to fit my needs a bit more. here is what I used

Sub test()
Const cDir = "c:\", cSubDir = "WINDOWS"

Dim strTemp As String
Dim filearray(10000)

strTemp = Dir(cDir, vbDirectory)

Do Until strTemp = ""
strTemp = Dir
a = a + 1
dottest = 0
'this loop determins if its a file or directory
For i = 1 To Len(strTemp)
If Mid(strTemp, i, 1) = "." Then
dottest = 1
End If
Next i

'now look to see whats there
If dottest = 0 Then
filearray(a) = strTemp
'MsgBox (strTemp)
End If
Loop

Open "c:\filearray.txt" For Output As #1
For j = 7 To a
Write #1, filearray(j)
Next j
Close #1


End Sub
 
Hi Mike,

Try this,

Example from VBA Help & modified.

Sub Test()
Dim filearray()
Dim a as long

Dim MyPath, MyName

MyPath = "C:\windows\temp\" ' Set the path.

MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If MyName <> "." And MyName <> ".." Then
' Use bitwise comparison to make sure MyName is a directory.
If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory
Then
'Debug.Print MyName ' Display entry only if it
represents a directory.

a = a + 1
ReDim Preserve filearray(a)
filearray(a) = MyName

End If
End If
MyName = Dir ' Get next entry.
Loop

Open "c:\filearray.txt" For Output As #1
For j = 1 To a
Write #1, filearray(j)
Next j
Close #1
End Sub



Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/
(Excel Add-ins)
 
Shailesh,
Can I direct an additional question regarding to your answer?.
Say I want to list *.doc files only under MyPath to that output file.
May you modify your solution accordingly?
TIA
for it!
 
Martyn,

Easy enough

Dim filearray()
Dim a As Long, j As Long

Dim MyPath, MyName

MyPath = "D:\Bob\bu Tasters\Excel\" ' Set the path.

MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
Do While MyName <> "" ' Start the loop.
' Ignore the current directory and the encompassing directory.
If Right(MyName, 4) = ".doc" Then
If MyName <> "." And MyName <> ".." Then
a = a + 1
ReDim Preserve filearray(a)
filearray(a) = MyName
End If
End If
MyName = Dir ' Get next entry.
Loop

Open "c:\filearray.txt" For Output As #1
For j = 1 To a
Write #1, filearray(j)
Next j
Close #1

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Hi Martyn,

Try this,

Sub ListFileName()

Dim filearray()
Dim MyPath, MyName, MyCond
Dim j As Long, a As Long

MyPath = "c:\windows\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry.
MyCond = ".txt"
Do While MyName <> "" ' Start the loop.
If (GetAttr(MyPath & MyName) And vbDirectory) <> vbDirectory Then
If UCase(Right(MyName), 4) = UCase(MyCond) Then
a = a + 1
ReDim Preserve filearray(a)
filearray(a) = MyName
End If
End If
MyName = Dir ' Get next entry.
Loop

Open "c:\filearray.txt" For Output As #1
For j = 1 To a
Write #1, filearray(j)
Next
Close #1
End Sub


You can also run in dos mode, DOS Internal command DIR :
e.g.

Dir c:\windows\*.txt > c:\filelist.txt

then you can view filelist.txt as under (in dos mode):
Type c:\filelist.txt


But with VBA you can adopt two methods below:

Sub BatchFile()
'To create batchfile that will run from Shell as we cann't use Shell
"C:\windows\*.txt > C:\filelist.txt"

Dim BatchFilename, OutputFilename, MyCond

BatchFilename = "c:\dirlist.bat" 'Batch Filename
OutputFilename = "c:\filelist.txt"

' Find the xls files starting with "s"
MyCond = "dir c:\s*.xls /s > " ' /S = search in all sub dir also

Open BatchFilename For Output As #1 ' Open file.
Print #1, MyCond & OutputFilename ' Write string to file.
Close #1 'close

Shell BatchFilename, vbNormalFocus 'Run batch File

End Sub

Sub DosCommand()

Dim OutputFilename, MyCond, Mac

OutputFilename = "C:\filelist.txt" ' output filename
' Find the xls files starting with "s"
MyCond = "dir C:\s*.xls /S" ' /S = search in all sub dir also

On Error Resume Next
Kill FileName ' if exist Kill. To append data remove or comment.
On Error GoTo 0

Mac = Shell(Environ$("comspec") & " /c " & MyCond & " > " &
OutputFilename, 1)

End Sub



Regards,
Shah Shailesh
http://members.lycos.co.uk/shahweb/
 
Unfortunately The VBA code didn't work...because there was a small command
error with this line:

If UCase(Right(MyName), 4) = UCase(MyCond) Then

I think we are not allowed to use anything else then just a string within
the "( )" for the UCase( xxxxxx) command.

Thus I changed your code a bit and now it works just fine...
Here goes:
--------------------------------
Sub ListFileName()

Dim filearray()
Dim MyPath, MyName, Mt, MyCond ' I declare an additional variable called
Mt
Dim j As Long, a As Long

MyPath = "c:\windows\" ' Set the path.
MyName = Dir(MyPath, vbDirectory) ' Retrive the first entry.
MyCond = ".txt"
Do While MyName <> "" ' Start the loop.
If (GetAttr(MyPath & MyName) And vbDirectory) <> vbDirectory Then
Mt = (Right(MyName, 4)) ' I use this new variable to get the last
four characters.
If UCase(Mt) = UCase(MyCond) Then ' And changed this bit such that
the format of UCase is accepted.
a = a + 1
ReDim Preserve filearray(a)
filearray(a) = MyName
End If
End If
MyName = Dir ' Get next entry.
Loop

Open "c:\filearray.txt" For Output As #1
For j = 1 To a
Write #1, filearray(j)
Next
Close #1

End Sub
 
Back
Top