Getfile name - and more - from a directory

[Brook70458]

I have been using this macro for several years and it has proven a great timesaver. I have tried modifying it to add the file datestamp (created and modified) to no avail; and it would be greatly beneficial to add type and size.

[ALSO, as a reference, what is a good book for data minig using MSExcel?]

Thank you in advance

Private Type BROWSEINFO ' used by the function GetFolderName
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

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


Sub GetFileNames()
Dim lRow As Long
Dim sPath As String
Dim sFname As String

sPath = GetFolderName("Select a folder")
If sPath = "" Then
Exit Sub
End If
sPath = sPath & "/"
lRow = 1
Cells(lRow, "a").Value = sPath
sFname = Dir(sPath & "*.*", vbNormal)
Do Until sFname = vbNullString
lRow = lRow + 1
Cells(lRow, "a").Value = sFname
sFname = Dir
Loop
End Sub


Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of directory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function

 

[tonyyy]

The following is untested...

Sub GetFileNames()
Dim lRow As Long
Dim sPath As String
Dim sFname As String
[COLOR=#0000ff]Dim FileSize As Double
Dim FileExtension As String[/COLOR]

sPath = GetFolderName("Select a folder")
If sPath = "" Then
    Exit Sub
End If
sPath = sPath & "/"
lRow = 1
Cells(lRow, "a").Value = sPath
sFname = Dir(sPath & "*.*", vbNormal)
Do Until sFname = vbNullString
    lRow = lRow + 1
    Cells(lRow, "a").Value = sFname
[COLOR=#0000ff]    Cells(lRow, "b") = FileDateTime(sPath & sFname)
    FileSize = FileLen(sPath & sFname)
    If FileSize < 0 Then FileSize = FileSize + 4294967296#
    Cells(lRow, "c") = FileSize
    FileExtension = Right(sFname, Len(sFname) - InStrRev(sFname, "."))
    Cells(lRow, "d") = FileExtension[/COLOR]
    sFname = Dir
Loop
End Sub

Cheers,

tonyyy

 

[Brook70458]

Thanks Tony, It doesn't work yet but I'll keep plugging away.

 

[tonyyy]

Sorry that didn't work out, Brook.

If you're willing to consider some different code rather than modifications to your existing macro, you might give the folloiwng a try. This is what I use on a somewhat regular basis...

Sub ListFiles()

'''''  This routine prompts you to select a file, then proceeds
'''''  to list all the files in that directory.

Dim FilePath As String
Dim Directory As String
Dim r As Long
Dim f As String
Dim FileSize As Double
Dim FileExtension As String

FilePath = Application.GetOpenFilename
If FilePath <> "" Then Directory = Left(FilePath, InStrRev(FilePath, "\"))
r = 1

''''  Insert headers
Cells(r, 1) = "FileName"
Cells(r, 2) = "Size"
Cells(r, 3) = "Date / Time"
Cells(r, 4) = "File Extension"
Range("A1:D1").Font.Bold = True

''''  Get first file
f = Dir(Directory, vbReadOnly + vbHidden + vbSystem)
Do While f <> ""
    r = r + 1
    Cells(r, 1) = f
''''  Adjust for filesize > 2 gigabytes
    FileSize = FileLen(Directory & f)
    If FileSize < 0 Then FileSize = FileSize + 4294967296#
    Cells(r, 2) = FileSize
    Cells(r, 3) = FileDateTime(Directory & f)
    FileExtension = Right(f, Len(f) - InStrRev(f, "."))
    Cells(r, 4) = FileExtension
''''  Get next file
    f = Dir()
Loop
ActiveSheet.Columns.AutoFit
End Sub

 

[Brook70458]

I like that - very cool. I like the ability to chose the file/directory.

All the code lists is the filename is column A, but doesn't fill in the column headers and respective metadata.

'''' Insert headers
Cells(r, 1) = "FileName"
Cells(r, 2) = "Size"
Cells(r, 3) = "Date / Time"
Cells(r, 4) = "File Extension"
Range("A1:D1").Font.Bold = True

 

[tonyyy]

Are you on a Mac or PC? And if on a PC, which versions of Windows and Excel?

 

[Brook70458]

Are you on a Mac or PC? And if on a PC, which versions of Windows and Excel?

PC: WIN 10 and MSExcel 2010 (interesting, your code must be for a Mac - 1st time seeing how a Mac would handle this. (I have been thinking on transitioning over )

 

[tonyyy]

Actually, I run the code on my Windows 7 laptop with Excel 2010.

Are the files you're trying to access on a local hard drive? Network? Sharepoint? The cloud?

 

[Brook70458]

Actually, I run the code on my Windows 7 laptop with Excel 2010.

Are the files you're trying to access on a local hard drive? Network? Sharepoint? The cloud?

only local.

 

[tonyyy]

I'm assuming the code is in a new workbook and the sheet and cells are unprotected and unhidden.

Let's try fully qualifying the range references...

Sub ListFiles()

'''''  This routine prompts you to select a file, then proceeds
'''''  to list all the files in that directory.

Dim FilePath As String
Dim Directory As String
Dim r As Long
Dim f As String
Dim FileSize As Double
Dim FileExtension As String

FilePath = Application.GetOpenFilename
If FilePath <> "" Then Directory = Left(FilePath, InStrRev(FilePath, "\"))
r = 1

''''  Insert headers
ActiveSheet.Cells(r, 1).Value = "FileName"
ActiveSheet.Cells(r, 2).Value = "Size"
ActiveSheet.Cells(r, 3).Value = "Date / Time"
ActiveSheet.Cells(r, 4).Value = "File Extension"
ActiveSheet.Range("A1:D1").Font.Bold = True

''''  Get first file
f = Dir(Directory, vbReadOnly + vbHidden + vbSystem)
Do While f <> ""
    r = r + 1
    ActiveSheet.Cells(r, 1).Value = f
''''  Adjust for filesize > 2 gigabytes
    FileSize = FileLen(Directory & f)
    If FileSize < 0 Then FileSize = FileSize + 4294967296#
    ActiveSheet.Cells(r, 2).Value = FileSize
    ActiveSheet.Cells(r, 3).Value = FileDateTime(Directory & f)
    FileExtension = Right(f, Len(f) - InStrRev(f, "."))
    ActiveSheet.Cells(r, 4).Value = FileExtension
''''  Get next file
    f = Dir()
Loop
ActiveSheet.Columns.AutoFit
End Sub