View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
PaulD PaulD is offline
external usenet poster
 
Posts: 92
Default File listing in excel

"PeterO" wrote in
message ...
:
: Hi Guys,
:
: I need some help, I am new to VB and I am looking to create an excel
: sheet that I can point at a folder and and create a file listing from
: it. For example:
:
: File Name, Creation date, file type, file size.
:
: I would like to have just one button that asks me to point a the folder
: and it does the rest.
:
: any advice would be really helpful
:
: Peter

Here is a routine I put together using some code I found here and some I
wrote. Place all of this in a new module or in a specific sheet code.
Create a button and point it to run CreateFolderList. I don't provide a
title row but you could easily enough record a macro to add the titles.
Paul D

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
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

Sub CreateFolderList()
Dim ff As Object, f As Object
Dim temp As Variant
Dim iRow As Integer
Dim fso As Object

Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
iRow = 1
Set ff = fso.GetFolder(GetFolderName)
Application.Cursor = xlWait
For Each f In ff.Files
Cells(iRow, 1).Value = f.Name
Cells(iRow, 2).Value = f.DateCreated
Cells(iRow, 3).Value = f.DateLastModified
Cells(iRow, 4).Value = f.Type
Cells(iRow, 5).Value = Format(f.Size / 1024, "#0.0") & "KB"
iRow = iRow + 1
Next
Application.Cursor = xlDefault
Application.ScreenUpdating = True
Set fso = Nothing
End Sub

''VBA macro tip contributed by Erlandsen Data Consulting
''offering Microsoft Excel Application development, template customization,
''support and training solutions

Function GetFolderName(Optional 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