Macro: Get all folder names and all file names

[Richard]

I am using Word 2000. And Windows XP. I am trying to get all folder names
and all file names from a specified folder on the C:\ drive or another drive
name into a Word document.

The following script is having a problem with this line:

Result = Dir(WhereAt, vbNormal)

and i get the error:

Run-time error'52'
Bad file name or number

Many thanks in advance.

--
Richard

Public StartFolder
Public FinalText() 'saving lines of text in this array for the final output
Public FollowTheFolders() 'this array will constantly change size and content
Sub CallEm()

Dim ArraySizeBefore As Integer 'How many folders on my list BEFORE next
search?
Dim Changed As Boolean 'Did the size of the folder list change during the
most recent search?
Dim x As Integer 'counter dummy

StartFolder = "O:\first folder\seconf folder\"
'you will want to change the value of StartFolder for your own needs
'IMPORTANT: you MUST include the final backslash at the end of
'the file path. "C:\foldername\" is good. "C:\foldername" is BAD.


ReDim FinalText(0)
ReDim FollowTheFolders(1)

FollowTheFolders(0) = StartFolder

Do While FollowTheFolders(0) <> "" 'the Do-loop will always run at least
once, because initially FollowTheFolders(0) will

always contain the string StartFolder

ArraySizeBefore = UBound(FollowTheFolders) 'save this info for later
comparison

GenerateListing (FollowTheFolders(0))
'call the subroutine GenerateListing

Changed = False
If UBound(FollowTheFolders) > ArraySizeBefore Then
Changed = True
End If

Strike FollowTheFolders()
'call the subroutine Strike

Loop

'****This section prints the output into the active word document

On Error Resume Next
ActiveDocument.Select
If Err.Number <> 0 Then
MsgBox "No open and active Word doc was found in which to " & vbCr _
& "type the results of the search. Please open a " & vbCr _
& "document and run this search macro again."
Err.Clear
Exit Sub
End If

For x = 0 To UBound(FinalText) - 1
Selection.Collapse wdCollapseEnd
Selection.TypeText FinalText(x)
Next x

End Sub

Sub GenerateListing(WhereAt As String)
'Once the main procedure (the CallEm procedure) determines the
'current folder to search in, this sub will add the names of
'any files in the folder to the output string array (FinalText),
'and then it will add any new folders found to the FollowTheFolders array

Dim Result As String

Result = Dir(WhereAt, vbNormal)

If Result <> "" Then
FinalText(UBound(FinalText)) = Result & " in " & WhereAt & vbNewLine
ReDim Preserve FinalText(UBound(FinalText) + 1)
End If

Do While Result <> ""

Result = Dir

If Result <> "" Then
FinalText(UBound(FinalText)) = Result & " in " & WhereAt & vbNewLine
ReDim Preserve FinalText(UBound(FinalText) + 1)
End If

Loop

'***********************************************

Result = Dir(WhereAt, vbDirectory)

If Result <> "" And Result <> ".." And Result <> "." _
And CBool(GetAttr(WhereAt & Result) And vbDirectory) = True Then

FollowTheFolders(UBound(FollowTheFolders)) = WhereAt & Result & "\"
ReDim Preserve FollowTheFolders(UBound(FollowTheFolders) + 1)
End If

Do While Result <> ""

Result = Dir

If Result <> "" And Result <> ".." And Result <> "." _
And CBool(GetAttr(WhereAt & Result) And vbDirectory) = True Then


FollowTheFolders(UBound(FollowTheFolders)) = WhereAt & Result & "\"
ReDim Preserve FollowTheFolders(UBound(FollowTheFolders) + 1)
End If

Loop

End Sub

Sub Strike(IncomingArray())
Dim x As Integer 'counter dummy

For x = 1 To UBound(IncomingArray)
IncomingArray(x - 1) = IncomingArray(x)
Next

ReDim Preserve IncomingArray(UBound(IncomingArray) - 1)

End Sub

 

[Lüko Willms]

Am Mon, 9 Oct 2006 10:58:02 UTC, schrieb Richard

I am using Word 2000. And Windows XP. I am trying to get all folder names
and all file names from a specified folder on the C:\ drive or another drive
name into a Word document.

Have a look at the file system object (short: fso), wich is part of
Microsoft scripting. You can use it also from VBA.

With fso, you can do all, what you explained above.


Yours,
L.W.

 

[garfield-n-odie [MVP]]

See http://word.mvps.org/FAQs/MacrosVBA/InsertFileNames.htm .