Welcome!

Thank you visiting ICB - Iceberg Code Blog
This is the place, where I'd like to share ideas and some useful code (VB, Excel, T-SQL, JavaScript, ...)
Table of Content

Tuesday, February 28, 2006

Excel List File

I have so many file and it's so hard to find them...
I'd like to search and sort them within Excel. I think it's easier because Excel manage big list.

For this reason I did a Excel file. List_File.xls to search, sort any file. It is very easy and fast to use!

Here's the code:


'32-bit API declarations
Public IndirizzoDirectory As String
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

Sub Sub_GetDirectory()
     ' Just to set some VAR and cal the GetDirectory Function
     Dim Msg_Directory As String
     Msg_Directory = Range("Msg_Directory")
     Range("Directory") = GetDirectory(Msg_Directory)
End Sub

Function GetDirectory(Optional Msg) As String
     ' open the browser to select a Directory into the PC
     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


Sub GetListFile()
' Just to set some VAR and call the ListFiles Sub
Dim SubFolder As Boolean, _
Directory As String, _
FileType As String

Directory = Range("Directory")
FileType = Range("FileType")
SubFolder = Range("SubFolder")

ListFiles Directory, FileType, SubFolder

End Sub


Sub ListFiles(Optional ByVal IndirizzoDirectory As String = "C:\", Optional ByVal NomeFile As String = "*.*", Optional ByVal CercaSottoCartelle As Boolean = False)
' if the directory is not ending with "\" it add it
If Right(IndirizzoDirectory, 1) <> "\" Then IndirizzoDirectory = IndirizzoDirectory & "\"

Range("OutPut").ClearContents

' Insert headers
r = 1

Cells(r, 1) = "Name"
Cells(r, 2) = "Size"
Cells(r, 3) = "Date/Time"
Range("A1:C1").Font.Bold = True
r = r + 1

On Error Resume Next
With Application.FileSearch
.NewSearch
.LookIn = IndirizzoDirectory
.Filename = NomeFile
.SearchSubFolders = CercaSottoCartelle
.Execute
For i = 1 To .FoundFiles.Count
Cells(r, 1) = .FoundFiles(i)
Cells(r, 2) = FileLen(.FoundFiles(i))
Cells(r, 3) = FileDateTime(.FoundFiles(i))
r = r + 1
Next i
End With
End Sub


Download it now

# posted by Lorenzo @ 12:12 PM 0 comments