Getting a file listing (DIR)

[Asrampd]

This will have been asked a thousand times - But I can find no code that actually works. I have searched the internet for completed Spreadsheets - VBA code - advice, all without success. It seems to me that there is a gap in the available functions.


I need to get a listing of files in a named folder, into Excel 2007.

Ta.

 

[Asrampd]

Mark,

I did that and put the following code in to get the folder the user wants, But it makes it run very slowly litterally taking 2 or more hours instead of less than a minute with the imbedded folder path. Any ideas why ?

Ta.

 

[MARK858]

Mark,

I did that and put the following code in to get the folder the user wants.

I don't see any following code but...
try replacing the sub test() with the code below

Sub test2()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
        For lCount = 1 To .SelectedItems.Count
            FName = .SelectedItems(lCount)
        Next lCount
    End With
    Call ListFilesInFolder(FName, True)
End Sub

 

[Asrampd]

Yes that works "Better". I have tested it and "Test2" cannot do the 6000 files Folder but it handles twice as much as the "Test".

Ta.

 

[taurean]

This is VBA based code which uses DOS. The code seems to fare decently on speed count. It listed 29000 files in 5 seconds.

I have added some code for custom formatting (FileName in Column A, Size in Column B(Converted to KB), Date Modified).

I have commented the code.

Option Explicit
Public Sub DOSThroughVBA()
Dim i As Long
Dim WScript As Object
Dim strPath As String, strCommand As String
Dim varList As Variant, varFilt As Variant, varPRS As Variant

Range("A:C").ClearContents

Set WScript = CreateObject("WScript.Shell")

On Error Resume Next
'Navigate to folder of which you need listing
strPath = CreateObject("Shell.Application").BrowseForFolder _
(0, "Select Folder For Listing", 0, "").Self.Path
On Error GoTo 0

If strPath = vbNullString Then MsgBox "No Folders Selected!", vbCritical: Exit Sub
'build dir based command for execution
strCommand = "cmd /c dir /s " & Chr(34) & strPath & Chr(34)

'Execute DOS command & get output in array
varList = Split(WScript.Exec(strCommand).StdOut.ReadAll, vbCrLf)
'Filter out unwanted data from array
varFilt = Filter(varList, "<DIR>", False, vbTextCompare)
ReDim varPRS(UBound(varFilt) - 3, 2)

For i = LBound(varFilt) + 2 To UBound(varFilt) - 3
    'Replacing these recursive words
    If InStr(varFilt(i), " Directory of ") > 0 Then
        varPRS(i, 0) = Replace(varFilt(i), " Directory of ", vbNullString)
    'Repositioning summary column
    ElseIf InStr(varFilt(i), " File(s) ") > 0 Then
        varPRS(i, 2) = varFilt(i)
    ElseIf IsDate(Mid(varFilt(i), 1, 20)) Then
        varPRS(i, 2) = Mid(varFilt(i), 1, 20)                        'Date
        varPRS(i, 1) = Round(Abs(Mid(varFilt(i), 21, 18)) / 1024, 2) 'Size in KB
        varPRS(i, 0) = Mid(varFilt(i), 39, Len(varFilt(i)) - 39)     'FileName
    Else
    'Rest of the data comes in as it is!
        varPRS(i, 0) = varFilt(i)
    End If
Next i

Range("A1").Resize(UBound(varPRS), 3) = varPRS

End Sub

 

[agkid]

Hi taurean,

I get a Run time error - Out of Memory.

 

[taurean]

Hi taurean,

I get a Run time error - Out of Memory.

Hi agkid,

Welcome to MrExcel.

I did not get such error during my testing. However, the code if copied from the code window above doesn't come out cleanly. Please test the code in the uploaded sample file. If the error still comes we'll look into it.

https://www.box.com/s/9009b7dc50d33d134aec

 

[agkid]

Hi taurean,

Thanks for your help. The file you provided did work.

Best, AG