change macro to be able to choose folder

[Jos1972]

Hello,
If found below macro that helps me to list the file names in a folder. What i would like to change is to have possibility to choose a folder instead of a fixed one. Can anyone help me?
thanks
jos


Sub ListAllFile()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim ws As Worksheet

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets.Add

'Get the folder object associated with the directory
Set objFolder = browseforfolder 'objFSO.GetFolder("C:\")

ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & "are:"

'Loop through the Files collection
For Each objFile In objFolder.Files
ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
Next

'Clean up!
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing

End Sub

 

[Ruddles]

Add this code to a new standard code module:-

Option Explicit
 
Public Function BrowseForFolder(Optional ByVal StartFolder As Variant)
 
  If IsMissing(StartFolder) Then StartFolder = ""
 
  If StartFolder <> "" Then
    If Right(StartFolder, 1) <> "\" Then StartFolder = StartFolder & "\"
  End If
  With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = StartFolder
    .Title = "Please choose a folder:-"
    .AllowMultiSelect = False
    If .Show = -1 Then BrowseForFolder = .SelectedItems(1)
  End With
 
End Function

and modify your code as follows:-

[COLOR=green]'Get the folder object associated with the directory[/COLOR]
Dim SelectedFolder As String
SelectedFolder = BrowseForFolder
If SelectedFolder = "" Then
[COLOR=green] ' do whatever you need to do when user cancels out of dialog box[/COLOR]
  MsgBox "User cancelled!" & Space(10), vbOKOnly + vbExclamation
  Exit Sub
End If
Set objFolder = objFSO.GetFolder(SelectedFolder)

 

[Jos1972]

Great stuff,
thanks for the reply.
This really helped a lot!
cheers,
jos