Help with "Get File List" Macro

[rosspmm]

Morning Folks,

I have the following code that I got from this forum,
Unfortunately, I keep getting the following error:

"Run time error 5 Invalid Procedure call or argument"
I have marked the error with doubled quotes and in red

I need to fix that and to be able to allow the user(s) to selct the directory path they wish to create a file list from.



Sub GetFileList()
Dim iCtr As Integer
Dim sTemp
Dim iPos As Long
Const MAX_LENGTH As Long = 60
'I need to allow the user select the directory here'
Const DIR_PATH As String = "N:\DEPT\Morley Projects\DD - Projects by Business Unit\2005\"
With Application.FileSearch
.NewSearch
.LookIn = DIR_PATH
.SearchSubFolders = True
.Filename = "*.*"
If .Execute > 0 Then
For iCtr = 1 To .FoundFiles.Count
sTemp = .FoundFiles(iCtr)
If Len(sTemp) > MAX_LENGTH Then
iPos = InStrRev(sTemp, "\")
If Len(sTemp) - iPos > MAX_LENGTH Then
iPos = 25
"" End If
Cells(iCtr, 1).Value = Left(sTemp, MAX_LENGTH - (Len(sTemp) - iPos)) & _
"..." & Right(sTemp, Len(sTemp) - iPos + 1) ""
Else
Cells(iCtr, 1).Value = .FoundFiles(iCtr)
End If
Next iCtr
End If
End With
End Sub


All help gratefully accepted

[Bob Phillips]

Sub GetFileList()
Dim iCtr As Integer
Dim sTemp
Dim iPos As Long
Const MAX_LENGTH As Long = 60
'I need to allow the user select the directory here'
Const DIR_PATH As String = "N:\DEPT\Morley Projects\DD - Projects by Business Unit\2005\"
With Application.FileSearch
.NewSearch
.LookIn = DIR_PATH
.SearchSubFolders = True
.Filename = "*.*"
If .Execute > 0 Then
For iCtr = 1 To .FoundFiles.Count
sTemp = .FoundFiles(iCtr)
If Len(sTemp) > MAX_LENGTH Then
iPos = InStrRev(sTemp, "\")
If Len(sTemp) - iPos > MAX_LENGTH Then
iPos = 25
End If
Cells(iCtr, 1).Value = Left(sTemp, MAX_LENGTH - (Len(sTemp) - iPos)) & _
"..." & Right(sTemp, Len(sTemp) - iPos + 1)
Else
Cells(iCtr, 1).Value = .FoundFiles(iCtr)
End If
Next iCtr
End If
End With
End Sub

[rosspmm]

That seems to be the same code I posted without any change - I only added the double quotes to show where the Runtime Error 5 occurred

[Bob Phillips]

That seems to be the same code I posted without any change - I only added the double quotes to show where the Runtime Error 5 occurred

Okay, that wasn't clear.

The version I posted ran fine for me, but that was because I couldn't see where your problem was.

The code looks a bit familiar, I remember it now. It seems that you have a filename greater than the MAX_LENGTH constant, that is why I made it a constant, so it could be tuned to fit.

You can either increase that constant, or run this version which automatically overrides it in this circumstance



Sub GetFileList()
Dim iCtr As Integer
Dim sTemp
Dim iPos As Long
Const MAX_LENGTH As Long = 30
'I need to allow the user select the directory here'
Const DIR_PATH As String = "N:\DEPT\Morley Projects\DD - Projects by Business Unit\2005\"
With Application.FileSearch
.NewSearch
.LookIn = DIR_PATH
.SearchSubFolders = True
.Filename = "*.*"
If .Execute > 0 Then
For iCtr = 1 To .FoundFiles.Count
sTemp = .FoundFiles(iCtr)
If Len(sTemp) > MAX_LENGTH Then
iPos = InStrRev(sTemp, "\")
If Len(sTemp) - iPos > MAX_LENGTH Then
iPos = 25
End If
If MAX_LENGTH - (Len(sTemp) - iPos) > 3 Then
Cells(iCtr, 1).Value = Left(sTemp, MAX_LENGTH - (Len(sTemp) - iPos)) & _
"..." & Right(sTemp, Len(sTemp) - iPos + 1)
Else
Cells(iCtr, 1).Value = Left(sTemp, 4) & _
"..." & Right(sTemp, Len(sTemp) - iPos + 1)
End If
Else
Cells(iCtr, 1).Value = .FoundFiles(iCtr)
End If
Next iCtr
End If
End With
End Sub


.

[rosspmm]

Thanks that works - now all I need is to be able o allow the user to specify the directory they wish to get the file list from via a dialogue box

[Bob Phillips]

Thanks that works - now all I need is to be able o allow the user to specify the directory they wish to get the file list from via a dialogue box

Here is one way. I believe that XL2002 has a browse dialog



With Application.FileDialog(msoFileDialogFolderPicker)
.Show
MsgBox .SelectedItems(1)
End With

Look up FileDialog in the VBA help

The pre XL2002 way is


Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, _
ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" _
(lpBrowseInfo As BROWSEINFO) As Long

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Function GetFolder(Optional ByVal Name As String = _
"Select a folder.") As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim oDialog As Long
bInfo.pidlRoot = 0& 'Root folder = Desktop
bInfo.lpszTitle = Name
bInfo.ulFlags = &H1 'Type of directory to Return
oDialog = SHBrowseForFolder(bInfo) 'display the dialog
'Parse the result
path = Space$(512)
GetFolder = ""
If SHGetPathFromIDList(ByVal oDialog, ByVal path) Then
GetFolder = Left(path, InStr(path, Chr$(0)) - 1)
End If
End Function

[rosspmm]

Excellent

Works superbly

Thanks for all the help