VBS code needs a tweak

August 5, 2009 at 17:45:39
Specs: Windows 7
I have some code that works pretty well, but I need it to do something a little different. As of right now, it searches through all folders and subfolders, and lists attributes of all files in an excel spreadsheet. I need it to only list files that have a DatLastAccessed of more than one year ago. Anyone have any idea?

Dim oFS : Set oFS = CreateObject( "Scripting.FileSystemObject" )
Dim sSDir : sSDir = oFS.GetAbsolutePathName( "E:\My Stuff" )
Dim sXlsFSpec : sXlsFSpec = oFS.GetAbsolutePathName( "E:\dirlist-test.xls" )
Dim dicCargo : Set dicCargo = CreateObject( "Scripting.Dictionary" )
Dim oExcel : Set oExcel = CreateObject( "Excel.Application" )
Dim oWBook : Set oWBook = oExcel.Workbooks.Add
Dim oWSheet : Set oWSheet = oWBook.Sheets( 1 )
Dim aProps : aProps = Array( "Name", "Size", "Type", "DateLastModified", "DateLastAccessed" )

Dim nRow : nRow = 1
Dim nCol : nCol = 1

Dim sCol
For Each sCol In aProps
oExcel.Cells( nRow, nCol ).Value = sCol
nCol = nCol + 1
Next
sCol = Chr( 64 + nCol )
With oWSheet.Range( "A" & nRow & ":" & sCol & nRow )
With .Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
End With
End With

Set dicCargo( "fncFile" ) = GetRef( "FileFncExcelFS" )
Set dicCargo( "fncDir" ) = GetRef( "DirFncExcelFS" )
Set dicCargo( "oSFolder" ) = Nothing
Set dicCargo( "oWSheet" ) = oWSheet
dicCargo( "aProps" ) = aProps
dicCargo( "nRow" ) = nRow + 1
dicCargo( "sCol" ) = sCol

recurseDirFS oFS.GetFolder( sSDir ), dicCargo, 0


oWSheet.Cells.Columns.AutoFit
oExcel.DisplayAlerts = False
oWBook.SaveAs sXlsFSpec
oWBook.Close
oExcel.Quit
WScript.Quit 0

Function FileFncExcelFS( oFile, dicCargo, nLevel )
Dim nCol : nCol = 0
Dim sProp
For Each sProp In dicCargo( "aProps" )
nCol = nCol + 1
dicCargo( "oWSheet" ).Cells( dicCargo( "nRow" ), nCol ).Value = EVal( "oFile." & sProp )
Next
dicCargo( "nRow" ) = dicCargo( "nRow" ) + 1

End Function
End If

Function DirFncExcelFS( oFolder, dicCargo, nLevel )
Const xlCenter = -4108
dicCargo( "nRow" ) = dicCargo( "nRow" ) + 1
dicCargo( "oWSheet" ).Cells( dicCargo( "nRow" ), 2 ).Value = nLevel & " " & oFolder.Path
With dicCargo( "oWSheet" ).Range( "A" & dicCargo( "nRow" ) & ":" & dicCargo( "sCol" ) & dicCargo( "nRow" ) )
.HorizontalAlignment = xlCenter
.MergeCells = True
With .Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 10
End With
End With
dicCargo( "nRow" ) = dicCargo( "nRow" ) + 1
End Function

Sub recurseDirFS( oFolder, dicCargo, nLevel )
Dim vRet : vRet = dicCargo( "fncDir" )( oFolder, dicCargo, nLevel )
Dim oItem
For Each oItem In oFolder.Files
vRet = dicCargo( "fncFile" )( oItem, dicCargo, nLevel )
Next
Dim nCnt
nCnt = oFolder.SubFolders.Count
If 0 < nCnt Then
For Each oItem In oFolder.SubFolders
recurseDirFS oItem, dicCargo, nLevel + 1
Next
End If
End Sub


See More: VBS code needs a tweak

Report •


#1
August 6, 2009 at 16:20:58
Okay, I have to get some code critiquing out of my system before I get to the modification.

End Function
End If
Oh, look! An errant "End If"! This should cause the script to crash; I assume it's a mis-copy/paste.

 sCol = Chr( 64 + nCol )
Does anyone see what he's doing here? Hint: The value of "A" is 65. Still no? Here's a tip for the budding Excel VBA programmers out there: You don't have to figure out the column's letter; Cells() will take a column's position as a number. Then maybe your program won't bomb when Excel goes from "Z" to "AA," and you don't.

 Set dicCargo( "fncFile"  ) = GetRef( "FileFncExcelFS" )
 Set dicCargo( "fncDir"   ) = GetRef( "DirFncExcelFS" )
 Set dicCargo( "oSFolder" ) = Nothing
 Set dicCargo( "oWSheet"  ) = oWSheet
     dicCargo( "aProps"   ) = aProps
     dicCargo( "nRow"     ) = nRow + 1
     dicCargo( "sCol"     ) = sCol
. . . I'm speechless. Why is he shoving everything into a Dictionary object? It's like he's paid by the character, and wants to obfuscate the code just enough so you have to run back to him for maintenance costs.


With that out of the way, in Sub recurseDirFS, replace:

 For Each oItem In oFolder.Files
     vRet = dicCargo( "fncFile" )( oItem, dicCargo, nLevel )
 Next

With:

 For Each oItem In oFolder.Files
     If DateDiff("yyyy", oItem.DateLastModified, Now) > 0 Then _
         vRet = dicCargo( "fncFile" )( oItem, dicCargo, nLevel )
 Next


Report •

#2
August 7, 2009 at 00:24:57
Thanks for the help Razor! I've tried learning vb by borrowing from others and adapting to my needs, but this script used dicCargo, which I've never seen anywhere else, so I was a little stumped.

And that errant End If was a leftover from my attempts to make it work.

I'll make sure and credit you in the final code. Thanks again!


Report •

Related Solutions


Ask Question