Is there a way to list the contents of a folder down a column in Excel.
Thought perhaps there might be a function to do this, but I'd take any
suggestions.
Many thanks.

'---------------------------------------------------------------------------------------
' Module : Mod_DirInfo
' DateTime : 8/01/01 18:06
' Author : Ivan F Moala
' Purpose : Lists xls File info
' Inputs : Directory
' Outputs : Full path name of file,size Kb of file,Date time of File
'---------------------------------------------------------------------------------------
Option Explicit
Option Base 1
Dim KbSum As Double
Const Dmsg = "Select the Directory to get xls File info from"

'Code for generating list of files in a directory...
'32-bit API declarations
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String)
As Long

Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public Type BROWSEINFO
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

Function GetDirectory(Optional Msg) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
' Root folder = Desktop
bInfo.pidlRoot = 0&
' Title in the dialog
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
Else
bInfo.lpszTitle = Msg
End If
' Type of directory to return
bInfo.ulFlags = &H1
' Display the dialog
x = SHBrowseForFolder(bInfo)
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Else
GetDirectory = ""
End If

End Function

Function GetFileList(FileSpec As String) As Variant
' Returns an array of filenames that match FileSpec
' If no matching files are found, it returns False
Dim FileSearch
Dim FileArray() As Variant
Dim i As Double
Dim Exists

On Error GoTo ErrSearch
Set FileSearch = Application.FileSearch

If Right(FileSpec, 1) < "\" Then FileSpec = FileSpec & "\"

Exists = Dir(FileSpec)
If Exists = "" Then GoTo ErrSearch

'Reset KbSum
KbSum = 0
With FileSearch
..NewSearch
..LookIn = FileSpec
..Filename = InputBox("Enter File Type ie.: *.mp3")
If .Execute 0 Then
ReDim FileArray(.FoundFiles.Count, 3)
For i = 1 To .FoundFiles.Count
FileArray(i, 1) = .FoundFiles(i)
KbSum = KbSum + FileLen(.FoundFiles(i)) \ 1024
FileArray(i, 2) = FileLen(.FoundFiles(i)) \ 1024 & " Kb"
FileArray(i, 3) = Format(FileDateTime(.FoundFiles(i)), "dd/mm/yy hh:mm:ss")
Next
Else
GetFileList = False
Exit Function
End If
End With

GetFileList = FileArray
Set FileSearch = Nothing

Exit Function
' Error handler
ErrSearch:

If Exists = "" Then On Error Resume Next: Err.Raise 76
MsgBox Err.Number & " : " & Err.Description, vbMsgBoxHelpButton, _
"Error Search", Err.HelpFile, Err.HelpContext
End
End Function

Sub ListToSheet_FileInfo()
Dim Dir_ToLookIn As String, x As Variant, i As Double

Dir_ToLookIn = GetDirectory(Dmsg)
x = GetFileList(Dir_ToLookIn)

Select Case IsArray(x)

Case True 'Files found

ActiveSheet.Range("A:C").Clear
[A1] = UBound(x) & " Files in Dir:= " & Dir_ToLookIn
[B1] = KbSum & " Kb"
[C1] = "File Date"

With Range("A1:C1")
..HorizontalAlignment = xlCenter
..Font.Bold = True
..Font.ColorIndex = 5
End With
With ActiveSheet
..Range("A2").Resize(UBound(x), 3) = x
..Range("A:C").Columns.AutoFit
End With
MsgBox "Done!....", vbInformation

Case False 'No files found
MsgBox "No matching files", vbCritical

End Select

x = ""

End Sub

Run the ListToSheet_FileInfo sub, and you should be all set.




--
If this posting was helpful, please click on the Yes button.
Regards,

Michael Arch.




"LyndieBee" wrote:

Is there a way to list the contents of a folder down a column in Excel.
Thought perhaps there might be a function to do this, but I'd take any
suggestions.
Many thanks.