search results into excel file 2

[DestroyerNr1]

Hi,

I want to search for files bigger than 10MB or equal on a terminal server. All the files found (also in the subsubsub... folders) must be put in an excel file.
The info of the files i look for is name, size, type, last modified and last accessed.
I found a script on that maybe will do the work but it doesn't put it in a xls file and the messageboxes must go away... the script must be modified.

here it is:

Dim FSO, WSH, objDirectory, objFile, TheFiles

Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("Wscript.Shell")


Set objDirectory = FSO.GetFolder("c:\")
Set TheFiles = objDirectory.Files

Parentfolder = mid(fso.GetFolder(objDirectory),InstrRev(fso.GetFolder(objDirectory),"\",-1,0)+1,len(fso.GetFolder(objDirectory)) - InstrRev(fso.GetFolder(objDirectory),"\",-1,0))
objextension = InputBox("Enter extension" & vbcrlf & vbcrlf & ".*" & vbcrlf & "mp3" & vbcrlf & "bmp" & vbcrlf & "exe")


If FSO.FileExists ("c:\FileNames " & Parentfolder & ".txt") then
FSO.DeleteFile "c:\FileNames " & Parentfolder & ".txt"
End If

Set txtFileName = FSO.CreateTextFile ("c:\FileNames " & Parentfolder & ".doc",TRUE)
Set txtFileName = Nothing
Set txtFileName = FSpenTextFile("c:\FileNames " & Parentfolder & ".doc", 8)

WorkWithSubFolders objDirectory

txtFileName.Close


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder

ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders

For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next

End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles

Set TheFiles = objDirectory.Files
For Each objFile in TheFiles
strExt = fso.GetExtensionName(objFile.Path)
If (strExt = objextension) Then
txtFileName.writeline objFile.Path & vbtab & objFile.Size & vbtab & objFile.DateCreated & vbtab & objFile.DateLastModified
end if
Next
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Hope someone can help me out here!

 

[DestroyerNr1]

hey,

Found another script that's almost perfect!
The only thing I want to change is that it looks for files bigger than 10 MB.
Can someone help me, it's pretty urgent!

Here is the script:

Dim FSO, WSH, objDirectory, objFile, TheFiles
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("Wscript.Shell")
Set objDirectory = FSO.GetFolder(InputBox("Enter Starting Folder"))
Set TheFiles = objDirectory.Files
'
' Create and Set up Excel Objects
Column = 1
Row = 1
RowErr = 1
Set objXL = WScript.CreateObject("Excel.Application")
'
objXL.Workbooks.Add
objXL.Cells(1,Column).Value = "Parent Folder"
objXL.Cells(1,Column+1).Value = "File Name"
objXL.Cells(1,Column+2).Value = "File Size"
objXL.Cells(1,Column+3).Value = "Date Created"
objXL.Cells(1,Column+4).Value = "Date Last Modified"
objXL.Visible = True
'
WorkWithSubFolders objDirectory
'
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub

'
'ListFilesWithExtension objDirectory
'
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
Set TheFiles = objDirectory.Files
For Each objFile in TheFiles
strExt = fso.GetExtensionName(objFile.Path)
If (strExt = "jpg") Or (strExt ="mpg") Or (strExt = "scr") Then
Row = Row+1
objXL.Cells(Row,Column).Value = objDirectory
objXL.Cells(Row,Column+1).Value = objFile.Name
objXL.Cells(Row,Column+2).Value = objFile.Size
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
End If
Next
End Sub
'
MsgBox("All Done!")
WScript.Quit

 

[tsuji]

DestroyerNr1,

If that's the urgent matter, I can only suggest not to write info for other files. Like this.
[tt]
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
Set TheFiles = objDirectory.Files
For Each objFile in TheFiles
[red]if objFile.size\(1024*1024) >= 10 then[/red]
Row = Row+1
objXL.Cells(Row,Column).Value = objDirectory
objXL.Cells(Row,Column+1).Value = objFile.Name
objXL.Cells(Row,Column+2).Value = objFile.Size
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
[red]End If[/red]
Next
End Sub
[/tt]
The detail, I have not looked into at all.

regards - tsuji

 

[SaMaLaKo]

Add the highlighted lines into the sub ListFilesWithExtension

Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
     Set TheFiles = objDirectory.Files
     For Each objFile in TheFiles
[Highlight]          If objFile.Size > 10000 'in Kb Then [/highLight]
               strExt = fso.GetExtensionName(objFile.Path)
                  If (strExt = "jpg") Or (strExt ="mpg") Or (strExt = "scr") Then
                       Row = Row+1
                    objXL.Cells(Row,Column).Value = objDirectory
                    objXL.Cells(Row,Column+1).Value = objFile.Name
                    objXL.Cells(Row,Column+2).Value = objFile.Size
                    objXL.Cells(Row,Column+3).Value = objFile.DateCreated
                    objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
               End If
[Highlight]          End If[/highLight]
     Next
End Sub

Please tell me if I'm wrong I like to learn from my mistakes...
_____________________________________
Feed a man a fish and feed him for a day.
Teach a man to fish and feed him for a lifetime...

 

[SaMaLaKo]

Not in Kb but in Bytes (was mixing up two things)
Tsuji is correct (as always).

Please tell me if I'm wrong I like to learn from my mistakes...
_____________________________________
Feed a man a fish and feed him for a day.
Teach a man to fish and feed him for a lifetime...

 

[DestroyerNr1]

Thanx guys!
That really helped! I did a test run on my c:\ but after a few minutes it errors out on this line, acces denied row 58 sign 6 code 800A0046:

For Each objFile in TheFiles

Any idea how to prevent this from happening?

 

[DestroyerNr1]

I think the error happens when the script is trying to acces the folder System Volume Information
Is it possible to skip this folder?

 

[tsuji]

DestroyerNr1,

If you start from c:\, chances are you will encounter this somehow, but not at that line. Try modify the .createdate line to this see if it resolves the problem.
[tt]
on error resume next
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
if err.number<>0 then
objXL.Cells(Row,Column+3).Value = "na"
err.clear
end if
on error goto 0
[/tt]
- tsuji

 

[DestroyerNr1]

Didn't solve the problem, sorry.
I let the script run on the terminal server too an after about 10-12 minutes of searching i get the same anoying error.
Do you have another idea?

 

[tsuji]

Why you do that with root for a testing? Start from its subfolders one by one until you know which property cause problem or even memory problem, because you are running against thousand and thousand of files!
- tsuji

 

[tsuji]

Furthermore, you may very quickly run out of rows available in the worksheet.
- tsuji

 

[DestroyerNr1]

Thanks for the fast response!
I did some testing on why i get this error and i only get when it's trying to acces a folder i can't open not even as domain administrator.
Memory is fine and i think i have rows enough because there aren't more then 1000 files who are bigger then 10 MB to put in excel.

Is there a way to skip these folders i can't open? They have a random name.

 

[tsuji]

I don't know...

Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
    on error resume next
    Set TheFiles = objDirectory.Files
    if err.number<>0 then err.clear : exit sub
    For Each objFile in TheFiles
          if err.number<>0 then err.clear : exit sub
          if objFile.size\(1024*1024) >= 10 then
                Row = Row+1
                objXL.Cells(Row,Column).Value = objDirectory
                objXL.Cells(Row,Column+1).Value = objFile.Name
                objXL.Cells(Row,Column+2).Value = objFile.Size
                objXL.Cells(Row,Column+3).Value = objFile.DateCreated
                if err.number<>0 then
                    objXL.Cells(Row,Column+3).Value = "na"
                    err.clear
                end if
                objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
           End If
     Next
     on error goto 0
End Sub

It just turns a blind eye on those folders! In case you care...

- tsuji

 

[DestroyerNr1]

I appreciate your help very much and I hate to say it tsuji but i still get the same error.
Maybe something wrong with my script?

Here it is:

Dim FSO, WSH, objDirectory, objFile, TheFiles
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("Wscript.Shell")
Set objDirectory = FSO.GetFolder(InputBox("Enter Starting Folder"))
Set TheFiles = objDirectory.Files
'
' Create and Set up Excel Objects
Column = 1
Row = 1
RowErr = 1
Set objXL = WScript.CreateObject("Excel.Application")
'
objXL.Workbooks.Add
objXL.Cells(1,Column).Value = "Parent Folder"
objXL.Cells(1,Column+1).Value = "File Name"
objXL.Cells(1,Column+2).Value = "File Size"
objXL.Cells(1,Column+3).Value = "Date Created"
objXL.Cells(1,Column+4).Value = "Date Last Modified"
objXL.Cells(1,Column+5).Value = "Date Last Accessed"
objXL.Visible = True
'
WorkWithSubFolders objDirectory
'
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub

'
'ListFilesWithExtension objDirectory
'
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
Set TheFiles = objDirectory.Files
if err.number<>0 then err.clear : exit sub
For Each objFile in TheFiles
if err.number<>0 then err.clear : exit sub
If objFile.Size\ (1024*1024) >= 10 then

Row = Row+1
objXL.Cells(Row,Column).Value = objDirectory
objXL.Cells(Row,Column+1).Value = objFile.Name
objXL.Cells(Row,Column+2).Value = objFile.Size
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
if err.number<>0 then
objXL.Cells(Row,Column+3).Value = "na"
err.clear
End If
objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
objXL.Cells(Row,Column+5).Value = objFile.DateLastAccessed
End if
Next
on error goto 0
End Sub
'
MsgBox("Hell Yeah!")
WScript.Quit

 

[DestroyerNr1]

I'm of for the weekend. Hope you can help me out!
See ya monday!

 

[tsuji]

Good thing to do. Me too. I have absolutely over-dose of fso and vbs of this forum. I'll take a look during weekend.
- tsuji

 

[PHV]

Testing for err.number<>0 without previous On Error Resume Next is useless.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[tsuji]

Destroyer,

It means you have missed out the line "On error resume next" below the line dim TheFiles as what I proposed up there. Add it back and test again.
[tt]
Dim TheFiles
[blue]on error resume next[/blue]
Set TheFiles = objDirectory.Files[/tt]

To improve the sharpness of error capture, add a line err.clear above the .datecreated write out in the newer version (at the place where the original "on error resume next" locates.) Like this.
[tt]
[green]err.clear[/green] 'add this, not vital though
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
if err.number<>0 then
objXL.Cells(Row,Column+3).Value = "na"
err.clear
End If
[/tt]
- tsuji

 

[g8orade]

Hi,
I modified this and got this line in my excel sheet
C:\System Volume Information na but the script continued. This is what worked for me.
Thanks guys I am just starting to get interested in scripting and think this will be a great resource. All of tek-tip tipsters rock.

Dim FSO, WSH, objDirectory, objFile, TheFiles
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("Wscript.Shell")
Set objDirectory = FSO.GetFolder(InputBox("Enter Starting Folder"))
Set TheFiles = objDirectory.Files
'
' Create and Set up Excel Objects
Column = 1
Row = 1
RowErr = 1
Set objXL = WScript.CreateObject("Excel.Application")
'
objXL.Workbooks.Add
objXL.Cells(1,Column).Value = "Parent Folder"
objXL.Cells(1,Column+1).Value = "File Name"
objXL.Cells(1,Column+2).Value = "File Size"
objXL.Cells(1,Column+3).Value = "Date Created"
objXL.Cells(1,Column+4).Value = "Date Last Modified"
objXL.Cells(1,Column+5).Value = "Date Last Accessed"
objXL.Visible = True
'
WorkWithSubFolders objDirectory
'
Sub WorkWithSubFolders(objDirectory)
Dim MoreFolders, TempFolder
ListFilesWithExtension objDirectory
Set MoreFolders = objDirectory.SubFolders
on error resume next
For Each TempFolder In MoreFolders
WorkWithSubFolders TempFolder
Next
End Sub

'
'ListFilesWithExtension objDirectory
'
Sub ListFilesWithExtension(objDirectory)
Dim TheFiles
on error resume next
Set TheFiles = objDirectory.Files
' if err.number<>0 then err.clear : exit sub
For Each objFile in TheFiles
' if err.number<>0 then err.clear : exit sub
If objFile.Size\ (1024*1024) >= 10 then

Row = Row+1
objXL.Cells(Row,Column).Value = objDirectory
objXL.Cells(Row,Column+1).Value = objFile.Name
objXL.Cells(Row,Column+2).Value = objFile.Size
err.clear
objXL.Cells(Row,Column+3).Value = objFile.DateCreated
if err.number<>0 then
objXL.Cells(Row,Column+3).Value = "na"
err.clear
End If
objXL.Cells(Row,Column+4).Value = objFile.DateLastModified
objXL.Cells(Row,Column+5).Value = objFile.DateLastAccessed
End if
Next
on error goto 0
End Sub
'
MsgBox("Hell Yeah!")
WScript.Quit

 

[DestroyerNr1]

Thanks guys!

You really helped me out here! It works perfectly!