CODEWITHSUNDEEP
excelvba
Kelsius
Kelsius

Reputation: 473

Get list of file names in folder/directory with Excel VBA

I have the following code which pulls the file names from the directory I specify. I found it on the internet and modified it to work for what I need.

The problem is that I don't want it to popup with a window asking me to pick a folder - I want to use the specified folder. How can I change this code so that I don't have to use the window, or if I can't change it, what can I do about my situation?

Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\Desktop" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$
    .Show
    If .SelectedItems.count <> 0 Then
        xDirect$ = .SelectedItems(1) & "\"
        xFname$ = Dir(xDirect$, 7)
        Do While xFname$ <> ""
            ActiveCell.Offset(xRow) = Left(xFname$, InStrRev(xFname$, ".") - 1)
            xRow = xRow + 1
            xFname$ = Dir
        Loop
    End If
End With

Upvotes: 0

Views: 26634

Answers (4)

CH Oldie
CH Oldie

Reputation: 61

The very first code was useful in my case. However I modified it, so it might be helpful for someone else.

Sub SelectAndListFiles()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\Desktop" '<<< Startup folder to begin searching from
With Application.FileDialog(msoFileDialogFilePicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$
    .Show
   If .SelectedItems.Count <> 0 Then
        xDirect$ = .SelectedItems(1)
        ActiveCell = Left(xDirect$, InStrRev(xDirect$, "\")) 'enter path in cell
        xRow = 1
        For n = 1 To .SelectedItems.Count
            xDirect$ = .SelectedItems(n)
            xFname$ = Dir(xDirect$, vbNormal)         'list all selected files
            ActiveCell.Offset(xRow) = xFname$
            xRow = xRow + 1
        Next n
    End If
End With
End Sub

Upvotes: 0

Leon Rom
Leon Rom

Reputation: 567

On my Excel-2010 the Kelsius's example works only with trailing (right) backslash in the directory name:

FileName = Dir("C:\Desktop\")

This is my full example:

Public Sub ReadFileList()
Dim bkp As String

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
Dim Idx As Integer
Dim rng As Range

    bkp = "E:\Flak\TRGRES\1\"

    If bkp <> "" Then
        FileCount = 0
        FileName = dir(bkp)

        Do While FileName <> ""
            Debug.Print FileName

            FileCount = FileCount + 1
            ReDim Preserve FileArray(1 To FileCount)
            FileArray(FileCount) = FileName
            FileName = dir()
        Loop
    End If
End Sub

Upvotes: 1

SeanC
SeanC

Reputation: 15923

This is the critical part of the code:

xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
    ActiveCell.Offset(xRow) = Left(xFname$, InStrRev(xFname$, ".") - 1)
    xRow = xRow + 1
    xFname$ = Dir
Loop

if you change the first line in that block to be

xDirect$ = My_Path_With_Trailing_Slash

you can specify any path you want

Upvotes: 1

Kelsius
Kelsius

Reputation: 473

I ended up changing my code completely and not using the old code. Again, I found some code on the internet and modified it to work for what I need.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim FileArray() As Variant
Dim FileCount As Integer
Dim FileName As String
Dim rng As Range
Dim Idx As Integer

FileCount = 0
FileName = Dir("C:\Desktop")

'   Loop until no more matching files are found
Do While FileName <> ""
    FileCount = FileCount + 1
    ReDim Preserve FileArray(1 To FileCount)
    FileArray(FileCount) = FileName
    FileName = Dir()
Loop
GetFileList = FileArray
Set rng = ActiveCell
For Idx = 0 To FileCount - 1
    ActiveCell.Offset(Idx, 0).Value = Left(FileArray(Idx + 1), InStrRev(FileArray(Idx + 1), ".") - 1)
Next Idx

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Upvotes: 3

Related Questions