Dynamic Folder directory

[jabawalkie5000]

Hi All

I am trying to include coding in a macro that enables the user to enter the path in the control tab of my report.

The macro can then read that string and go to the desired folder to open the selected files

Can anyone help?

Many Thanks

 

[jabawalkie5000]

Sorry I just got back home. Will test this first thing tomorrow and confirm its perfect.

Many Thanks All

Combining mine and Richard's

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = "C:\"  'default start location
    .Title = "Please select a folder"
    If .Show = -1 Then
        MyFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
MyFile = Dir(MyFolder & "\*.*")
Do While MyFile <> ""
    If MyFile Like "*.doc" Or MyFile Like "*.xls" Or MyFile Like "*.ppt" Then
        j = j + 1
        Sheets("Sheet1").Cells(j, 1).Value = MyFile
    End If
    MyFile = Dir
Loop
End Sub

 

[jabawalkie5000]

It works, thanks

If I wanted it to give me a count of the amount of files matching the criteria below in a message box before importing the files to sheet1, how do I do it?

Thanks

Combining mine and Richard's

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = "C:\"  'default start location
    .Title = "Please select a folder"
    If .Show = -1 Then
        MyFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
MyFile = Dir(MyFolder & "\*.*")
Do While MyFile <> ""
    If MyFile Like "*.doc" Or MyFile Like "*.xls" Or MyFile Like "*.ppt" Then
        j = j + 1
        Sheets("Sheet1").Cells(j, 1).Value = MyFile
    End If
    MyFile = Dir
Loop
End Sub

 

[VoG]

Try this

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
Dim FoundFiles()
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = "C:\"  'default start location
    .Title = "Please select a folder"
    If .Show = -1 Then
        MyFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
MyFile = Dir(MyFolder & "\*.*")
Do While MyFile <> ""
    If MyFile Like "*.doc" Or MyFile Like "*.xls" Or MyFile Like "*.ppt" Then
        j = j + 1
        ReDim Preserve FoundFiles(1 To j)
        FoundFiles(j) = MyFile
    End If
    MyFile = Dir
Loop
If j = 0 Then
    MsgBox "No files found", vbInformation
    Exit Sub
End If
If MsgBox("Found " & j & " files, continue", vbQuestion + vbYesNo) = vbNo Then Exit Sub
For j = 1 To UBound(FoundFiles)
    Sheets("Sheet1").Cells(j, 1).Value = FoundFiles(j)
Next j
End Sub

 

[jabawalkie5000]

Thank you , it works.

Here is another question, actually two questions but I will ask this one first:

I have another macro that brings up a user form that allows me to chose from sheet1 which files I want to open. It stores this info in a tab called "list". This user form has two buttons on it, "ok" and "close". "ok" is to select a file, "close" is to finish after selection. I want an undo button that can allow you to undo previous selection in turn in reverse order. Similar to the undo function in excel, can you help with this?

Try this

Sub ListFiles()
Dim MyFolder As String
Dim MyFile As String
Dim j As Integer
Dim FoundFiles()
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = "C:\"  'default start location
    .Title = "Please select a folder"
    If .Show = -1 Then
        MyFolder = .SelectedItems(1)
    Else
        Exit Sub
    End If
End With
MyFile = Dir(MyFolder & "\*.*")
Do While MyFile <> ""
    If MyFile Like "*.doc" Or MyFile Like "*.xls" Or MyFile Like "*.ppt" Then
        j = j + 1
        ReDim Preserve FoundFiles(1 To j)
        FoundFiles(j) = MyFile
    End If
    MyFile = Dir
Loop
If j = 0 Then
    MsgBox "No files found", vbInformation
    Exit Sub
End If
If MsgBox("Found " & j & " files, continue", vbQuestion + vbYesNo) = vbNo Then Exit Sub
For j = 1 To UBound(FoundFiles)
    Sheets("Sheet1").Cells(j, 1).Value = FoundFiles(j)
Next j
End Sub

 

[jabawalkie5000]

Thanks, it works