Dir Related

[Benz]

Hi, I'm writing a piece of code and for it to target the correct Excel
document I need the user to select the doc and where it is. From searching
on here I found code (See Below) which should bring up a Directory search box
which lists all files within the folders the user navigates through in the
search box. The problem is only folders show up.

What do I have to change within the code to allow the user to only select an
Excel doc? or to list all files?

Thank you in advance for any help!

Ben Z.

Public Sub CreateFileList()
Dim aDir As Variant
Dim i As Integer
Dim oDoc As Document
Dim PathToUse As String
Dim pExt As String
PathToUse$ = GetPathToUse
If PathToUse = "No selection" Or PathToUse = "Error" Then Exit Sub
pExt = InputBox("Enter file extension or '*' for all file types.", _
"Extension", "*")
Set oDoc = Documents.Add
aDir = fDirList(PathToUse, "." & pExt)
For i = 0 To UBound(aDir)
oDoc.Range.InsertAfter aDir(i) & vbCrLf
Next i
End Sub
Public Function fDirList(sPath As String, sExt As String) As Variant
Dim MyFile As String
Dim Counter As Long
'Create a dynamic array variable declare a liberal initial size
Dim DirListArray() As String
ReDim DirListArray(0) As String
Counter = 0
'Loop through all the files in the directory by using Dir$ function
MyFile = Dir$(sPath & "*" & sExt)
Do While MyFile <> ""
DirListArray(Counter) = MyFile
MyFile = Dir$
Counter = Counter + 1
ReDim Preserve DirListArray(Counter)
Loop
fDirList = DirListArray
End Function
Private Function GetPathToUse() As Variant
On Error GoTo Handler
'Get the folder containing the files. Note - The "Copy Dialog" is used
to
'to display the "open" option
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
GetPathToUse = .Directory
Else
GetPathToUse = "No selection"
Exit Function
End If
End With
If Left(GetPathToUse, 1) = Chr(34) Then
GetPathToUse = Mid(GetPathToUse, 2, Len(GetPathToUse) - 2)
End If
Exit Function
Handler:
GetPathToUse = "Error"
Err.Clear
End Function

 

[macropod]

Hi Benz,

That's the way that code is meant to work - it browses to the folder and, after you confirm the folder selection, asks you what file
extensions you want a listing for. If you type 'xls' into the input box, the macro will create a new document listing all the files
with an 'xls' extension in that folder.

Here's some code to show all the files in the folder and allow you to pick however many of whatever type you want.
Sub FindFiles()
Dim FoundFile As Variant
'create FileDialog object as File Picker dialog box
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each FoundFile In .SelectedItems
msgbox FoundFile 'gets new filepath
Next
End If
End With
End Sub

If you want to set the starting folder to the one the Word document is in and to limit the files to 'xls' files, then add the line:
.InitialFileName = ActiveDocument.Path & "*.xls"
after the line 'With Application ...'

Cheers

 

[Benz]

Works great , thank you!

Ben Z.

Hi Benz,

That's the way that code is meant to work - it browses to the folder and, after you confirm the folder selection, asks you what file
extensions you want a listing for. If you type 'xls' into the input box, the macro will create a new document listing all the files
with an 'xls' extension in that folder.

Here's some code to show all the files in the folder and allow you to pick however many of whatever type you want.
Sub FindFiles()
Dim FoundFile As Variant
'create FileDialog object as File Picker dialog box
With Application.FileDialog(FileDialogType:=msoFileDialogFilePicker)
'use Show method to display File Picker dialog box and return user's action
If .Show = -1 Then
'step through each string in the FileDialogSelectedItems collection
For Each FoundFile In .SelectedItems
msgbox FoundFile 'gets new filepath
Next
End If
End With
End Sub

If you want to set the starting folder to the one the Word document is in and to limit the files to 'xls' files, then add the line:
.InitialFileName = ActiveDocument.Path & "*.xls"
after the line 'With Application ...'

Cheers
--
macropod
[MVP - Microsoft Word]
-------------------------

Hi, I'm writing a piece of code and for it to target the correct Excel
document I need the user to select the doc and where it is. From searching
on here I found code (See Below) which should bring up a Directory search box
which lists all files within the folders the user navigates through in the
search box. The problem is only folders show up.

What do I have to change within the code to allow the user to only select an
Excel doc? or to list all files?

Thank you in advance for any help!

Ben Z.

Public Sub CreateFileList()
Dim aDir As Variant
Dim i As Integer
Dim oDoc As Document
Dim PathToUse As String
Dim pExt As String
PathToUse$ = GetPathToUse
If PathToUse = "No selection" Or PathToUse = "Error" Then Exit Sub
pExt = InputBox("Enter file extension or '*' for all file types.", _
"Extension", "*")
Set oDoc = Documents.Add
aDir = fDirList(PathToUse, "." & pExt)
For i = 0 To UBound(aDir)
oDoc.Range.InsertAfter aDir(i) & vbCrLf
Next i
End Sub
Public Function fDirList(sPath As String, sExt As String) As Variant
Dim MyFile As String
Dim Counter As Long
'Create a dynamic array variable declare a liberal initial size
Dim DirListArray() As String
ReDim DirListArray(0) As String
Counter = 0
'Loop through all the files in the directory by using Dir$ function
MyFile = Dir$(sPath & "*" & sExt)
Do While MyFile <> ""
DirListArray(Counter) = MyFile
MyFile = Dir$
Counter = Counter + 1
ReDim Preserve DirListArray(Counter)
Loop
fDirList = DirListArray
End Function
Private Function GetPathToUse() As Variant
On Error GoTo Handler
'Get the folder containing the files. Note - The "Copy Dialog" is used
to
'to display the "open" option
With Dialogs(wdDialogCopyFile)
If .Display <> 0 Then
GetPathToUse = .Directory
Else
GetPathToUse = "No selection"
Exit Function
End If
End With
If Left(GetPathToUse, 1) = Chr(34) Then
GetPathToUse = Mid(GetPathToUse, 2, Len(GetPathToUse) - 2)
End If
Exit Function
Handler:
GetPathToUse = "Error"
Err.Clear
End Function