Sunday, November 16, 2008

List File in a folder using VBA in Microsoft Excel

Microsoft Scripting Runtime is included in these products:  
Windows98, Windows2000, IE5, and Office2000.  
The macro examples below assumes that your VBA project has added a reference to the 
Microsoft Scripting Runtime library.  
You can do this from within the VBE by selecting the menu Tools, References and selecting 

Microsoft Scripting Runtime.  

********************** Code**************************************************************************

Sub TestListFilesInFolder() 
  Workbooks.Add ' create a new workbook for th
  ' add headers 
  With Range("A1") 
  .Formula = "Folder contents:" 
  .Font.Bold = True 
  .Font.Size = 12 
  End With 
  Range("A3").Formula = "File Name:" 
  Range("B3").Formula = "File Size:" 
  Range("C3").Formula = "File Type:" 
  Range("D3").Formula = "Date Created:" 
  Range("E3").Formula = "Date Last Accessed:" 
  Range("F3").Formula = "Date Last Modified:" 
  Range("G3").Formula = "Attributes:" 
  Range("H3").Formula = "Short File Name:" 
  Range("A3:H3").Font.Bold = True 
  ListFilesInFolder "C:\FolderName\", True 
' list all files included subfolders 
End Sub

****************************** Code 2***************************************

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder 
' example: ListFilesInFolder "C:\FolderName\", True 
Dim FSO As Scripting.FileSystemObject 
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder 
Dim FileItem As Scripting.File 
Dim r As Long 
  Set FSO = New Scripting.FileSystemObject 
  Set SourceFolder = FSO.GetFolder(SourceFolderName) 
  r = Range("A65536").End(xlUp).Row + 1 
  For Each FileItem In SourceFolder.Files 
  ' display file properties 
  Cells(r, 1).Formula = FileItem.Path & FileItem.Name 
  Cells(r, 2).Formula = FileItem.Size 
  Cells(r, 3).Formula = FileItem.Type 
  Cells(r, 4).Formula = FileItem.DateCreated 
 Cells(r, 5).Formula = FileItem.DateLastAccessed 
  Cells(r, 6).Formula = FileItem.DateLastModified 
  Cells(r, 7).Formula = FileItem.Attributes 
  Cells(r, 8).Formula = FileItem.ShortPath & FileItem.ShortName 
  ' use file methods (not proper in this example) 
' FileItem.Copy "C:\FolderName\Filename.txt", True 
' FileItem.Move "C:\FolderName\Filename.txt" 
' FileItem.Delete True 
  r = r + 1 ' next row number 
  Next FileItem 
  If IncludeSubfolders Then 
  For Each SubFolder In SourceFolder.SubFolders 
  ListFilesInFolder SubFolder.Path, True 
  Next SubFolder 
  End If 
  Columns("A:H").AutoFit 
  Set FileItem = Nothing 
  Set SourceFolder = Nothing 
  Set FSO = Nothing 
  ActiveWorkbook.Saved = True 
End Sub

No comments: