And my final effort... It's time for some really ugly VBA code...=20
Here's a word macro that will do it, though the formatting of the output =
leaves a lot to be desired. I guess you could sort the file easily =
enough once it's generated. Put the directory to be listed in the =
startdir variable and run the FindDirectory macro.
Rob
-------------------
Sub FindDirectory()
Dim aryFoundDirectories()
Dim MyPath As String
Dim MyName As String
startdir =3D "C:\"
'replace with starting directory - you need the final backslash
' so "C:\TEMP\" is a valid string
On Error GoTo NEXT_STEP
'find all directories and subdirs from a starting point
current =3D 0
dircount =3D 0
currentdir =3D startdir
While current <=3D dircount
subdirect =3D Dir(currentdir, vbDirectory + vbHidden)
While subdirect <> ""
If subdirect <> "." And subdirect <> ".." Then
If (GetAttr(currentdir & subdirect) And vbDirectory) =3D =
vbDirectory Then
dircount =3D dircount + 1
ReDim Preserve aryFoundDirectories(dircount)
aryFoundDirectories(dircount) =3D currentdir & subdirect =
& "\"
End If
End If
subdirect =3D Dir
Wend
current =3D current + 1
currentdir =3D aryFoundDirectories(current)
Wend
dircount =3D dircount + 1
ReDim Preserve aryFoundDirectories(dircount)
aryFoundDirectories(dircount) =3D startdir
NEXT_STEP:
'find all files with matching extensions
For I =3D 1 To UBound(aryFoundDirectories())
Selection.InsertAfter Text:=3DaryFoundDirectories(I) & Chr(13)
Selection.Start =3D Selection.End
MyPath =3D aryFoundDirectories(I)
MyName =3D Dir$(MyPath & "*.*")
Do While MyName <> ""
Selection.InsertAfter aryFoundDirectories(I) & MyName & Chr(13)
MyName =3D Dir
Loop
=20
'collapse the selection
Selection.Collapse wdCollapseEnd
=20
Next
' lastly get all the files in the starting directory
MyPath =3D startdir
MyName =3D Dir$(MyPath & "*.*")
Do While MyName <> ""
Selection.InsertAfter startdir & MyName & Chr(13)
MyName =3D Dir
Loop
=20
'collapse the selection
Selection.Collapse wdCollapseEnd
End Sub
**************************************************
To post a message to austechwriter, send the message to
austechwriter@xxxxxxxxxxxxxx
To subscribe to austechwriter, send a message to
austechwriter-request@xxxxxxxxxxxxx with "subscribe" in the Subject field.
To unsubscribe, send a message to austechwriter-request@xxxxxxxxxxxxx with
"unsubscribe" in the Subject field.
To search the austechwriter archives, go to
www.freelists.org/archives/austechwriter
To contact the list administrator, send a message to
austechwriter-admins@xxxxxxxxxxxxx
**************************************************