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

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

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