Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Read directory code which needs to include file size
Hello,
I was given a macro to me that will prompt the user for a file path and then it returns 1) the file path 2) the name of each file in that path 3) the date that the file was created. Eg. Entering c:\escheatables will return column 1 column 2 column 3 c:\escheatables Actions Items.xls 8/24/2006 9:22 c:\escheatables Queries.doc 7/30/2007 10:40 ......etc. I would like to also have it return the size of the file, but my visual basic knowledge is not advanced enough to understand how the current code works. I'm hoping that this may be a fairly easy addition for someone with more experience with this type of code. The current code is shown below. Thanks for any help on this. Global MyFileData As New Collection Global MyFiles As New Collection Global MySubDir As New Collection Sub ReadDirectory(MySearchPath) Dim MyName MyName = Dir(MySearchPath, vbDirectory) Do While MyName < "" ' Start the loop. If (GetAttr(MySearchPath & MyName) And vbDirectory) < vbDirectory Then MyFiles.Add Item:=MyName Dim fs, f, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(MySearchPath & MyName) s = f.DateLastModified MyFileData.Add Item:=s End If MyName = Dir ' Get next entry. Loop End Sub Sub ReadAllDirectory(tmpSubDirectory) Dim MySearchPath, MyFileSystemObject, MyFolder, MySubFolders, MyOneSubFolder MySearchPath = tmpSubDirectory & "\" Set MyFileSystemObject = CreateObject("Scripting.FileSystemObject") Set MyFolder = MyFileSystemObject.getfolder(MySearchPath) Set MySubFolders = MyFolder.subfolders For Each MyOneSubFolder In MySubFolders MySubDir.Add Item:=MyOneSubFolder Call ReadAllDirectory(MyOneSubFolder & "\") Next MyOneSubFolder End Sub Sub MainSearch() Dim rowcount, tmpMainDirectory rowcount = 1 tmpMainDirectory = InputBox("Example: S:\Desk Procedures", "Please enter Root Directory Name") Call ReadDirectory(tmpMainDirectory & "\") For y = 1 To MyFiles.Count Cells(rowcount, 1).Value = tmpMainDirectory Cells(rowcount, 2).Value = MyFiles.Item(1) Cells(rowcount, 3).Value = MyFileData.Item(1) rowcount = rowcount + 1 MyFiles.Remove 1 MyFileData.Remove 1 Next y Call ReadAllDirectory(tmpMainDirectory) For x = 1 To MySubDir.Count Call ReadDirectory(MySubDir.Item(1) & "\") For y = 1 To MyFiles.Count Cells(rowcount, 1).Value = MySubDir.Item(1) Cells(rowcount, 2).Value = MyFiles.Item(1) Cells(rowcount, 3).Value = MyFileData.Item(1) rowcount = rowcount + 1 MyFiles.Remove 1 MyFileData.Remove 1 Next y MySubDir.Remove 1 Next x MsgBox ("Macro complete!") End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Read directory code which needs to include file size
I'm not into scripting yet but I found this in the help files. Maybe you can
do somehing with it. filespec is your folder name. Sub ShowFolderSize(filespec) Dim fs, f, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFolder(filespec) s = UCase(f.Name) & " uses " & f.size & " bytes." MsgBox s, 0, "Folder Size Info" End Sub "tbmarlie" wrote: Hello, I was given a macro to me that will prompt the user for a file path and then it returns 1) the file path 2) the name of each file in that path 3) the date that the file was created. Eg. Entering c:\escheatables will return column 1 column 2 column 3 c:\escheatables Actions Items.xls 8/24/2006 9:22 c:\escheatables Queries.doc 7/30/2007 10:40 ......etc. I would like to also have it return the size of the file, but my visual basic knowledge is not advanced enough to understand how the current code works. I'm hoping that this may be a fairly easy addition for someone with more experience with this type of code. The current code is shown below. Thanks for any help on this. Global MyFileData As New Collection Global MyFiles As New Collection Global MySubDir As New Collection Sub ReadDirectory(MySearchPath) Dim MyName MyName = Dir(MySearchPath, vbDirectory) Do While MyName < "" ' Start the loop. If (GetAttr(MySearchPath & MyName) And vbDirectory) < vbDirectory Then MyFiles.Add Item:=MyName Dim fs, f, s Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(MySearchPath & MyName) s = f.DateLastModified MyFileData.Add Item:=s End If MyName = Dir ' Get next entry. Loop End Sub Sub ReadAllDirectory(tmpSubDirectory) Dim MySearchPath, MyFileSystemObject, MyFolder, MySubFolders, MyOneSubFolder MySearchPath = tmpSubDirectory & "\" Set MyFileSystemObject = CreateObject("Scripting.FileSystemObject") Set MyFolder = MyFileSystemObject.getfolder(MySearchPath) Set MySubFolders = MyFolder.subfolders For Each MyOneSubFolder In MySubFolders MySubDir.Add Item:=MyOneSubFolder Call ReadAllDirectory(MyOneSubFolder & "\") Next MyOneSubFolder End Sub Sub MainSearch() Dim rowcount, tmpMainDirectory rowcount = 1 tmpMainDirectory = InputBox("Example: S:\Desk Procedures", "Please enter Root Directory Name") Call ReadDirectory(tmpMainDirectory & "\") For y = 1 To MyFiles.Count Cells(rowcount, 1).Value = tmpMainDirectory Cells(rowcount, 2).Value = MyFiles.Item(1) Cells(rowcount, 3).Value = MyFileData.Item(1) rowcount = rowcount + 1 MyFiles.Remove 1 MyFileData.Remove 1 Next y Call ReadAllDirectory(tmpMainDirectory) For x = 1 To MySubDir.Count Call ReadDirectory(MySubDir.Item(1) & "\") For y = 1 To MyFiles.Count Cells(rowcount, 1).Value = MySubDir.Item(1) Cells(rowcount, 2).Value = MyFiles.Item(1) Cells(rowcount, 3).Value = MyFileData.Item(1) rowcount = rowcount + 1 MyFiles.Remove 1 MyFileData.Remove 1 Next y MySubDir.Remove 1 Next x MsgBox ("Macro complete!") End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Read directory code which needs to include file size
I don't have excel installed on this laptop, but it'll be something
along the lines of what I've added below: here is a brief summary and explanation 1) add s2 to the dim statement in ReadDirectory() 'declare a new variable to hold the file size 2) add s2 = f.FileSize 'set the new variable equal to the file size property. Since I don't have excel on this laptop you may need to search within the VB editor for the correct property name. (just search for filesize) 3) add MyFileData.add Item:=s2 'this just adds another item (aka property) to the MyFileData object so you can call it in the next line. 4) add cells(rowcount,4).value = MyFileData.Item(2) 'add this twice, both times the macro is adding the properties list to the sheet. This is by no means error proof code and you'll probably have to figure out a little bit about the parts i've added. I hope this helps and doesn't just make it more frustrating. There's nothing worse that code that has no comments or worthless comments to explain what the author was thinking when it was writen. Cheers! Nate On Mar 3, 11:18 am, tbmarlie wrote: Hello, I was given a macro to me that will prompt the user for a file path and then it returns 1) the file path 2) the name of each file in that path 3) the date that the file was created. Eg. Entering c:\escheatables will return column 1 column 2 column 3 c:\escheatables Actions Items.xls 8/24/2006 9:22 c:\escheatables Queries.doc 7/30/2007 10:40 .....etc. I would like to also have it return the size of the file, but my visual basic knowledge is not advanced enough to understand how the current code works. I'm hoping that this may be a fairly easy addition for someone with more experience with this type of code. The current code is shown below. Thanks for any help on this. Global MyFileData As New Collection Global MyFiles As New Collection Global MySubDir As New Collection Sub ReadDirectory(MySearchPath) Dim MyName MyName = Dir(MySearchPath, vbDirectory) Do While MyName < "" ' Start the loop. If (GetAttr(MySearchPath & MyName) And vbDirectory) < vbDirectory Then MyFiles.Add Item:=MyName Dim fs, f, s, s2 Set fs = CreateObject("Scripting.FileSystemObject") Set f = fs.GetFile(MySearchPath & MyName) s = f.DateLastModified s2 = f.FileSize MyFileData.Add Item:=s MyFileData.add Item:=s2 End If MyName = Dir ' Get next entry. Loop End Sub Sub ReadAllDirectory(tmpSubDirectory) Dim MySearchPath, MyFileSystemObject, MyFolder, MySubFolders, MyOneSubFolder MySearchPath = tmpSubDirectory & "\" Set MyFileSystemObject = CreateObject("Scripting.FileSystemObject") Set MyFolder = MyFileSystemObject.getfolder(MySearchPath) Set MySubFolders = MyFolder.subfolders For Each MyOneSubFolder In MySubFolders MySubDir.Add Item:=MyOneSubFolder Call ReadAllDirectory(MyOneSubFolder & "\") Next MyOneSubFolder End Sub Sub MainSearch() Dim rowcount, tmpMainDirectory rowcount = 1 tmpMainDirectory = InputBox("Example: S:\Desk Procedures", "Please enter Root Directory Name") Call ReadDirectory(tmpMainDirectory & "\") For y = 1 To MyFiles.Count Cells(rowcount, 1).Value = tmpMainDirectory Cells(rowcount, 2).Value = MyFiles.Item(1) Cells(rowcount, 3).Value = MyFileData.Item(1) cells(rowcount,4).value = MyFileData.Item(2) rowcount = rowcount + 1 MyFiles.Remove 1 MyFileData.Remove 1 Next y Call ReadAllDirectory(tmpMainDirectory) For x = 1 To MySubDir.Count Call ReadDirectory(MySubDir.Item(1) & "\") For y = 1 To MyFiles.Count Cells(rowcount, 1).Value = MySubDir.Item(1) Cells(rowcount, 2).Value = MyFiles.Item(1) Cells(rowcount, 3).Value = MyFileData.Item(1) cells(rowcount,4).value = MyFileData.Item(2) rowcount = rowcount + 1 MyFiles.Remove 1 MyFileData.Remove 1 Next y MySubDir.Remove 1 Next x MsgBox ("Macro complete!") End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Include password in VBA code to open file problem | Excel Programming | |||
Include password in VBA code to open file problem | Excel Programming | |||
Include password in VBA code to open file problem | Excel Programming | |||
KeepITKool - Directory and File Size | Excel Programming | |||
code to strip back (from the right) a directory but not the file name | Excel Programming |