How can this be spead up??

[sparkbyte]

This script creates a new Excel Workbook and Spreadsheet
for the Drive, File Extension and Beginning DateTime
(LastModified) the user specifies.
The new Excel document is placed in the users "My Documents" directory by default.

This script ran relatively quick until I added the abililty to get the file Owner.

Anyone have any ideas on how to put some life back into this script??

Thanks Tsuji for the code that the DateToWMIDate function was written from.

'==========================================================================
'
' NAME: List_Apps_On_Drive (prompts for drive letter and file extension).vbs
'
' AUTHOR:  John F. Fuhrman III
' DATE  :  1/22/2010
' 
' COMMENT: This script creates a new Excel Workbook and Spreadsheet 
'          for the Drive and File Extension the user specifies.
'          The new Excel document is placed in the users "My Documents"
'          directory by default.
'
'==========================================================================
 strComputer = "."     ' use "." for local computer 
 
 strDrive=UCase(InPutBox("Enter Drive Letter", "Search Drive", "O")) 
 
 strExtension=UCase(InPutBox("Enter File Name Extension to search for.", _
								"File Extension Search", "MDB")) 
 
 strDateInput=InPutBox("Enter beginning date for Search" & VBcrlf & _
                    "Ending Date will be " & Date() & " 12:00 AM", _
					"Date Range Search", datevalue(dateadd("m",-3,Now())) _
					& " 12:00 AM")

 Set objWMIService = GetObject("winmgmts:" _ 
     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
 
 Set colFiles = objWMIService. _ 
     ExecQuery("Select * from CIM_DataFile" _ 
         & " where Drive=" & "'" & strDrive & ":'" _
         & " AND Extension='" & strExtension & "'" _
         & " AND LastModified>'" & ConvDateTimeWMI(strDateInput)& "'") 
' WScript.Echo "# of files found: " & colFiles.Count 

 
' 
' Set colFiles = objWMIService. _ 
'     ExecQuery("Select * from CIM_DataFile" _ 
'         & " where Drive=" & "'" & strDrive & ":' and Extension='" &_
'                strExtension & "'") 
' WScript.Echo "# of files found: " & colFiles.Count 

' Spreadsheet file to be created.
strExcelPath = strExtension & "-File_Listing_for_Drive_" & strDrive & ".xls"
' Wscript.Echo strExcelPath

' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If
On Error GoTo 0

'Set this True if you would like to see the Spreadsheet being updated.
objExcel.Visible = True 

'Create a new workbook
objExcel.Workbooks.Add

' Bind to worksheet.
Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1)
objWorksheet.Name = strExtension & "-File Listing for Drive " & strDrive

' Populate spreadsheet cells with user attributes.
objWorksheet.Cells(1,1).Value = "Access Application Name"          'Cell A1
objWorksheet.Cells(1,2).Value = "Drive"                            'Cell B1
objWorksheet.Cells(1,3).Value = "Location"                         'Cell C1
objWorksheet.Cells(1,4).Value = "File Size"                        'Cell D1
objWorksheet.Cells(1,5).Value = "Creation Date"                    'Cell E1
objWorksheet.Cells(1,6).Value = "Last Modified"                    'Cell F1
objWorksheet.Cells(1,7).Value = "File Owner        "               'Cell G1
objWorksheet.Cells(1,8).Value = "Point of Contact"                 'Cell H1
objWorksheet.Cells(1,9).Value = "POC Contact Number"               'Cell I1
objWorksheet.Cells(1,10).Value = "File Status"                     'Cell J1

'Set Column Headings to Bold
objWorksheet.Range("A1:Z1").Font.Bold = True

'Defign Worksheet Ranges for Sorting and column sizing.
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("B1")    'Sort by Drive'
Set objRange3 = objExcel.Range("C1")    'Sort by Path'
Set objRange4 = objExcel.Range("D1")    'Sort by Size'

'Autofit all columns
objRange.EntireColumn.Autofit()

k = 2
 For Each objFile in colFiles 
        objWorksheet.Cells(k,1).Value = objFile.FileName                    'A
        objWorksheet.Cells(k,2).Value = objFile.Drive                       'B
        objWorksheet.Cells(k,3).Value = objFile.Path                        'C
        objWorksheet.Cells(k,4).Value = objFile.FileSize                    'D
        objWorksheet.Cells(k,5).Value = ConvWMITime(objFile.CreationDate)     'E
        objWorksheet.Cells(k,6).Value = ConvWMITime(objFile.LastModified)     'G
            If GetOwner(objFile.Name) = NULL Then                           'H
            objWorksheet.Cells(k,7).Value = "Unknown" 
            ElseIf GetOwner(objFile.Name) = "" Then
            objWorksheet.Cells(k,7).Value = "Unknown"
            Else 
            objWorksheet.Cells(k,7).Value = GetOwner(objFile.Name)
            End If
'' Uncomment for Testing filling in of worksheet
'    Wscript.echo k
'    if k >=7 then 
''   objExcel.ActiveWorkbook.SaveAs strExcelPath
'    objExcel.ActiveWorkbook.Close
'    wscript.quit
'    End if 
    k = k + 1
Next

' Format the spreadsheet.
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1

'Autofit all columns
objRange.EntireColumn.Autofit()

'Set srting order
'objRange.Sort objRange2, xlAscending, , , , , , xlYes
 objRange.Sort objRange3, xlAscending, , , , , , xlYes
'objRange.Sort objRange4, xlAscending, , , , , , xlYes

' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

'=============================================================================
'     Section for Functions
'=============================================================================

'************************************************************************************
' Convert WMI Time Function
'************************************************************************************
Function ConvWMITime(wmiTime)
On Error Resume Next
 
yr = left(wmiTime,4)
mo = mid(wmiTime,5,2)
dy = mid(wmiTime,7,2)
tm = mid(wmiTime,9,6)
 
ConvWMITime = mo & "/" & dy & "/" & yr & " " & FormatDateTime(left(tm,2) & _
":" & Mid(tm,3,2) & ":" & Right(tm,2),3)
 
End Function
 
'EOF

'************************************************************************************
' Convert WMI Time Function
'************************************************************************************
Function dtConvert(strDateTime)
' Convert File DateTime Stamp to a readable format
    strConvertDT = CDate(Mid(strDateTime, 5, 2) & "/" &_
                    Mid(strDateTime, 7, 2) & _
                    "/" & Left(strDateTime, 4) & " " &_
                    Mid (strDateTime, 9, 2) & ":" & _
                    Mid(strDateTime, 11, 2) & ":" & _
                    Mid(strDateTime, 13, 2))
    dtConvert = strConvertDT
End Function

'EOF

'************************************************************************************
' Get File Attribute "Owner"
'************************************************************************************
Function GetOwner(strFile)
strComputer = "."
Set objWMI = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

On Error Resume Next

Set objCollection = objWMI.ExecQuery _
("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" & strFile _
& "'} WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")

For Each objSID in objCollection
GetOwner = objSID.AccountName
Next

If VarType(GetOwner) = 0 Then
GetOwner = "error"
End If
End Function

'EOF

'************************************************************************************
' Convert Standard DateTime to WMI DateTime Function
'************************************************************************************
Function ConvDateTimeWMI(strDateTime)
set oswbemdtm=createobject("wbemscripting.swbemdatetime")
    oswbemdtm.setvardate strDateTime,true 'CONVERT_TO_LOCAL_TIME=true
    ConvDateTimeWMI = oswbemdtm
set oswbemdtm = Nothing
End Function
'EOF


'=============================================================================
'     Section for SubRoutines
'=============================================================================

Thanks

John Fuhrman
faq329-6766
faq329-7301
thread329-1334328
thread329-1424438

 

[Geates]

The biggest speedbump is the constant creation and destruction of WMI objects. Two things jump out at me.

1. Your GetOwner() function creates a local (scope-wise) WMI object of the local machine. This is unnecessary because you've already defined it globally at the beginning of your script - objWMIService. Modify your function to use this object.

2. The GetOwner() function is called upto 3 times for each file you process. This amounts to excessive labor and yield nothing you already knew. Call the function once and store the value in a variable for comparing:

strOwner = GetOwner(strFile)
if strOwner = null then
...

These two changes will should bring the script back upto speed!

-Geates

 

[mrmovie]

Geates recommendations are spot on, where possible i try and aviiod method/sub/function calls in If/Select Case etc statements. (mainly due to early versions of .net debug processes not liking it, issues with error handling etc)

it wont make much difference but all i can add, at the moment, is your use of 'SELECT * FROM ', perhaps only returning the things you are really interested in could be seen as more efficient (though i doubt you will realise any speed improvements)

 

[sparkbyte]

OK, make the changes. Still seems to be quite slow.

'====================================================================================
'
' NAME: List_Apps_On_Drive (prompts for drive letter and file extension).vbs
'
' AUTHOR:  John F. Fuhrman III
' DATE  :  1/22/2010
' 
' COMMENT: This script creates a new Excel Workbook and Spreadsheet 
'          for the Drive and File Extension the user specifies.
'          The new Excel document is placed in the users "My Documents"
'          directory by default.
'
'====================================================================================
 strComputer = "."     ' use "." for local computer 

Set objWMIService = GetObject("winmgmts:" _ 
     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

 strDrive=UCase(InPutBox("Enter Drive Letter", "Search Drive", "O")) 
 
 strExtension=UCase(InPutBox("Enter File Name Extension to search for.", _
								"File Extension Search", "MDB")) 
 
 strDateInput=InPutBox("Enter beginning date for Search" & VBcrlf & _
                    "Ending Date will be " & Date() & " 12:00 AM", _
					"Date Range Search", datevalue(dateadd("m",-6,Now())) _
					& " 12:00 AM")
 
 Set colFiles = objWMIService. _ 
     ExecQuery("SELECT * FROM CIM_DataFile" _ 
         & " WHERE Drive = '" & strDrive & ":'" _
         & " AND Extension = '" & strExtension & "'" _
         & " AND LastModified > '" & ConvDateTimeWMI(strDateInput)& "'") 
     StrFileCount = colFiles.Count
 WScript.Echo "# of files found: " & colFiles.Count 

' Spreadsheet file to be created.
strExcelPath = strExtension & "-File_Listing_for_Drive_" & strDrive & ".xls"
' Wscript.Echo strExcelPath

' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If
On Error GoTo 0

'Set this True if you would like to see the Spreadsheet being updated.
objExcel.Visible = True 

'Create a new workbook
objExcel.Workbooks.Add

' Bind to worksheet.
Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1)
objWorksheet.Name = strExtension & "-File Listing for Drive " & strDrive

' Populate spreadsheet cells with user attributes.
objWorksheet.Cells(1,1).Value = "Access Application Name"          'Cell A1
objWorksheet.Cells(1,2).Value = "Drive"                            'Cell B1
objWorksheet.Cells(1,3).Value = "Location"                         'Cell C1
objWorksheet.Cells(1,4).Value = "File Size"                        'Cell D1
objWorksheet.Cells(1,5).Value = "Creation Date"                    'Cell E1
objWorksheet.Cells(1,6).Value = "Last Modified"                    'Cell F1
objWorksheet.Cells(1,7).Value = "File Owner        "               'Cell G1
objWorksheet.Cells(1,8).Value = "Point of Contact"                 'Cell H1
objWorksheet.Cells(1,9).Value = "POC Contact Number"               'Cell I1
objWorksheet.Cells(1,10).Value = "File Status"                     'Cell J1

'Set Column Headings to Bold
objWorksheet.Range("A1:Z1").Font.Bold = True

'Defign Worksheet Ranges for Sorting and column sizing.
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("B1")    'Sort by Drive'
Set objRange3 = objExcel.Range("C1")    'Sort by Path'
Set objRange4 = objExcel.Range("D1")    'Sort by Size'

'Autofit all columns
objRange.EntireColumn.Autofit()

k = 2
 For Each objFile in colFiles 
        objWorksheet.Cells(k,1).Value = objFile.FileName                    'A
        objWorksheet.Cells(k,2).Value = objFile.Drive                       'B
        objWorksheet.Cells(k,3).Value = objFile.Path                        'C
        objWorksheet.Cells(k,4).Value = objFile.FileSize                    'D
        objWorksheet.Cells(k,5).Value = ConvWMITime(objFile.CreationDate)   'E
        objWorksheet.Cells(k,6).Value = ConvWMITime(objFile.LastModified)   'G
            
        strOwner = GetOwner(objFile.Name)                                   'H
            If strOwner =  NULL Then
                objWorksheet.Cells(k,7).Value = "Unknown" 
                ElseIf strOwner = "" Then
                objWorksheet.Cells(k,7).Value = "Unknown"
                Else 
                objWorksheet.Cells(k,7).Value = strOwner
            End If
k = k + 1
Next

strFileAlert = msgbox("File Search Completed",65,"ALERT")

' Format the spreadsheet.
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1

'Autofit all columns
objRange.EntireColumn.Autofit()

'Set srting order
'objRange.Sort objRange2, xlAscending, , , , , , xlYes
 objRange.Sort objRange3, xlAscending, , , , , , xlYes
'objRange.Sort objRange4, xlAscending, , , , , , xlYes

' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

'====================================================================================
'     Section for Functions
'====================================================================================

'************************************************************************************
' Convert WMI Time Function
'************************************************************************************
Function ConvWMITime(wmiTime)
On Error Resume Next
 
yr = left(wmiTime,4)
mo = mid(wmiTime,5,2)
dy = mid(wmiTime,7,2)
tm = mid(wmiTime,9,6)
 
ConvWMITime = mo & "/" & dy & "/" & yr & " " & FormatDateTime(left(tm,2) & _
":" & Mid(tm,3,2) & ":" & Right(tm,2),3)
 
End Function
 
'EOF

'************************************************************************************
' Convert WMI Time Function
'************************************************************************************
Function dtConvert(strDateTime)
' Convert File DateTime Stamp to a readable format
    strConvertDT = CDate(Mid(strDateTime, 5, 2) & "/" &_
                    Mid(strDateTime, 7, 2) & _
                    "/" & Left(strDateTime, 4) & " " &_
                    Mid (strDateTime, 9, 2) & ":" & _
                    Mid(strDateTime, 11, 2) & ":" & _
                    Mid(strDateTime, 13, 2))
    dtConvert = strConvertDT
End Function

'EOF

'************************************************************************************
' Get File Attribute "Owner"
'************************************************************************************
Function GetOwner(strFile)


' When processing multiple files make the WMI Local Computer Object Global!
' (Move outside the Function)

'strComputer = "."
'Set objWMIService = GetObject("winmgmts:" _ 
'     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

Set objCollection = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" & strFile _
& "'} WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")

For Each objSID in objCollection
GetOwner = objSID.AccountName
Next

If VarType(GetOwner) = 0 Then
GetOwner = "error"
End If
End Function

'EOF

'************************************************************************************
' Convert Standard DateTime to WMI DateTime Function
'************************************************************************************
Function ConvDateTimeWMI(strDateTime)
set oswbemdtm=createobject("wbemscripting.swbemdatetime")
    oswbemdtm.setvardate strDateTime,true 'CONVERT_TO_LOCAL_TIME=true
    ConvDateTimeWMI = oswbemdtm
set oswbemdtm = Nothing
End Function
'EOF


'===================================================================================
'     Section for SubRoutines
'===================================================================================

Thanks

John Fuhrman
faq329-6766
faq329-7301
thread329-1334328
thread329-1424438

 

[Geates]

Creating and destorying complete objects is resource intensive compared to "objectified" text streams. I wrote a searh program in Powershell; it was only 2 lines long but because PS uses full objects, the script took for ever. I rewrote it in a relatively long vbscript that parses text streams instead and it finished 97% faster!

Instead of using complete file and computer objects, use a representative namespace.

'Put in beginner of script
set objFolder = objShell.Namespace ("C:\temp")

'New GetOwner function.
function GetOwner(strFileName)
GetOwner = objFolder.GetDetailsOf (strFileName, 10)
end function


-Geates

 

[sparkbyte]

OK, I get what your saying, but the code

set objFolder = objShell.Namespace ("C:\temp")

Gets just the folder content information?

This script is searching an entire drive (or mapped drive). How could I impliment something like this for an entire drive?



Thanks

John Fuhrman
faq329-6766
faq329-7301
thread329-1334328
thread329-1424438

 

[Geates]

Same thing. Just specify the drive as the namespace. You'll want to redefine the objFolder namespace for each file if they have a different parent namespace(folder).

Do so by passing the objFile to the GetOwner function and using the objFile.ParentFolder property.

strOwner = GetOwner(objFile)
function GetOwner(objFile)
   set objFolder = objShell.NameSpace(objFile.ParentFolder)
   GetOwner = objFolder.GetDetailsOf (strFileName, 10)
end function

Or by parsing the strFileName for the parent folder. Make sure that you pass the full path (objFile.Path) instead of just the file name (objFile.Name). Likely a bit faster as it's not working with objects.

strOwner = GetOwner(objFile.Path)
function GetOwner(strFileName)
   set objFolder = objShell.NameSpace(left(strFileName, inStr(strFileName, "\")))
   GetOwner = objFolder.GetDetailsOf (strFileName, 10)
end function

-Geates

function GetOwner(strFileName)

 

[sparkbyte]

When I tried to use your function I get this message.

Object doesn't support this property or method: 'objFile.ParentFolder'



Thanks

John Fuhrman
faq329-6766
faq329-7301
thread329-1334328
thread329-1424438

 

[Geates]

I guess .NameSpace doesn't like objects. Because your script loops through FSO objects, we need to convert the object properties to the correctly vartype. At least, this is my interpretation - I could just be blowing hot air

function GetOwner(objFile)
   [red]strParentFolder = objFile.ParentFolder[/red]
   set objFolder = objShell.NameSpace(strParentFolder)
   [red]set objItem = objFolder.ParseName(objFile.Name)[/red]
   GetOwner = objFolder.GetDetailsOf (objItem, 10)
end function

-Geates

 

[sparkbyte]

I will give it a shot in a little while.

Here is the script currently after a day of messing with it.

Commented it be sections and converted the user input to functions. (Still need to find a way to merge them.)
Brain frazzle from staring at this script too long....

'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
' NAME: List_Apps_On_Drive (prompts for drive letter and file extension).vbs
'
' AUTHOR:  John F. Fuhrman III
' DATE  :  1/22/2010
' 
' COMMENT: This script creates a new Excel Workbook and Spreadsheet 
'          for the Drive and File Extension the user specifies.
'          The new Excel document is placed in the users "My Documents"
'          directory by default.
' UPDATED:
'       2/2/2010 - John Fuhrman
'       Added ability to query date range.
'
'       2/8/2010 - John Fuhrman
'       Added coments to code by sections.
'       Converted user prompts to Functions.
'       Added File Extension
'       Added * to Search for All Files
'       Removed Date Time Search (Can be filtered in Excel)
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

 strComputer = "."     ' use "." for local computer 

Set objWMIService = GetObject("winmgmts:" _ 
     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

Set objShell = CreateObject("Wscript.Shell")

Const TIMEOUT = 10  ' Constant set for User error prompt timeout

'******************************************************************************
' Prompted User Input
'******************************************************************************
strDrive     = funDriveSelect

strExtension = funFileExtention

'strDateInput = funDateInput

'******************************************************************************
' Create Spreadsheet and Open Excel
'******************************************************************************

' Spreadsheet file to be created.
If strExtension = "*" Then
    strExcelPath = "File_Listing_for_Drive_" & strDrive & ".xls"
Else
    strExcelPath = strExtension & "-File_Listing_for_Drive_" & strDrive & ".xls"
End If
' Wscript.Echo strExcelPath

' Bind to Excel object.
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  On Error GoTo 0
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If
On Error GoTo 0

'Set this True if you would like to see the Spreadsheet being updated.
objExcel.Visible = True 

'Create a new workbook
objExcel.Workbooks.Add

' Bind to worksheet.
Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1)
If strExtension = "*" Then
    objWorksheet.Name = "File Listing for Drive " & strDrive
Else
    objWorksheet.Name = strExtension & "-File Listing for Drive " & strDrive
End If
' Populate spreadsheet cells with user attributes.
objWorksheet.Cells(1,1).Value =  "File Type"                      'Cell A1
objWorksheet.Cells(1,2).Value =  "File Name"                      'Cell B1
objWorksheet.Cells(1,3).Value =  "File Extension"                 'Cell C1
objWorksheet.Cells(1,4).Value =  "Drive"                          'Cell D1
objWorksheet.Cells(1,5).Value =  "Folder"                         'Cell E1
objWorksheet.Cells(1,6).Value =  "File Size"                      'Cell F1
objWorksheet.Cells(1,7).Value =  "Creation Date"                  'Cell G1
objWorksheet.Cells(1,8).Value =  "Last Modified"                  'Cell H1
objWorksheet.Cells(1,9).Value =  "File Owner"                     'Cell I1
objWorksheet.Cells(1,10).Value = "Point of Contact"               'Cell J1
objWorksheet.Cells(1,11).Value = "POC Contact Number"             'Cell K1
objWorksheet.Cells(1,12).Value = "File Status"                    'Cell L1

'******************************************************************************
'Set Column Headings to Bold
'******************************************************************************
objWorksheet.Range("A1:Z1").Font.Bold = True

'******************************************************************************
' Format the spreadsheet.
'******************************************************************************
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1

'******************************************************************************
'Defign Worksheet Ranges for Sorting and column sizing.
'******************************************************************************
Set objRange = objWorksheet.UsedRange
Set objRange1 = objExcel.Range("A1")    'Sort by File Type
Set objRange2 = objExcel.Range("B1")    'Sort by File Name
Set objRange3 = objExcel.Range("C1")    'Sort by Extension
Set objRange4 = objExcel.Range("D1")    'Sort by Drive Letter
Set objRange5 = objExcel.Range("E1")    'Sort by Path
Set objRange6 = objExcel.Range("F1")    'Sort by File Size
Set objRange7 = objExcel.Range("G1")    'Sort by Creation Date
Set objRange8 = objExcel.Range("H1")    'Sort by Last Modified
Set objRange9 = objExcel.Range("I1")    'Sort by File Owner

'******************************************************************************
'Autofit all columns
'******************************************************************************
objRange.EntireColumn.Autofit()

'******************************************************************************
' Search for user specified files
'******************************************************************************
 
 If strExtension = "*" Then
      Set colFiles = objWMIService. _ 
         ExecQuery("SELECT * FROM CIM_DataFile" _ 
             & " WHERE Drive = '" & strDrive & ":'")
         StrFileCount = colFiles.Count
 Else
     Set colFiles = objWMIService. _ 
         ExecQuery("SELECT * FROM CIM_DataFile" _ 
             & " WHERE Drive = '" & strDrive & ":'" _
             & " AND Extension = '" & strExtension & "'")
         StrFileCount = colFiles.Count
 End If
' WScript.Echo "# of files found: " & colFiles.Count 

'******************************************************************************
' Fill in the open Excel Spreadsheet 
'******************************************************************************

k = 2
 For Each objFile in colFiles 
        objWorksheet.Cells(k,1).Value = objFile.FileType                    'A
        objWorksheet.Cells(k,2).Value = objFile.FileName                    'B
        objWorksheet.Cells(k,3).Value = objFile.Extension                   'C
        objWorksheet.Cells(k,4).Value = objFile.Drive                       'D
        objWorksheet.Cells(k,5).Value = objFile.Path                        'E
        objWorksheet.Cells(k,6).Value = objFile.FileSize                    'F
        objWorksheet.Cells(k,7).Value = ConvWMITime(objFile.CreationDate)   'G
        objWorksheet.Cells(k,8).Value = ConvWMITime(objFile.LastModified)   'H
            strOwner = GetOwner(objFile.Name)                               'I
                If strOwner =  NULL Then
                    objWorksheet.Cells(k,9).Value = "Unknown" 
                    ElseIf strOwner = "" Then
                    objWorksheet.Cells(k,9).Value = "Unknown"
                    Else 
                    objWorksheet.Cells(k,9).Value = strOwner
                End If
k = k + 1
'    End If
Next


'******************************************************************************
'Autofit all columns
'******************************************************************************
objRange.EntireColumn.Autofit()

'******************************************************************************
'Set sorting order
'******************************************************************************
'    objRange.Sort objRange1, xlAscending, , , , , , xlYes
'    objRange.Sort objRange2, xlAscending, , , , , , xlYes
'    objRange.Sort objRange3, xlAscending, , , , , , xlYes
'    objRange.Sort objRange4, xlAscending, , , , , , xlYes

    objRange.Sort objRange5, xlAscending, objRange1, , xlDescending, _
        objRange8, xlDescending, xlYes

'******************************************************************************
'Display Count of ROWS Added
'******************************************************************************
strFileCountMSG = msgbox(k - 2 & " ROWS written out of " & StrFileCount,_
                        48,"ALERT")

'******************************************************************************
' Save Spreadsheet and Quit Excel.
'******************************************************************************
' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit


'******************************************************************************
' Convert WMI Time Function
'******************************************************************************
Function ConvWMITime(wmiTime)
On Error Resume Next
 
yr = left(wmiTime,4)
mo = mid(wmiTime,5,2)
dy = mid(wmiTime,7,2)
tm = mid(wmiTime,9,6)
 
ConvWMITime = mo & "/" & dy & "/" & yr & " " & FormatDateTime(left(tm,2) & _
":" & Mid(tm,3,2) & ":" & Right(tm,2),3)
End Function

'******************************************************************************
' Convert WMI Time Function
'******************************************************************************
Function dtConvert(strDateTime)
' Convert File DateTime Stamp to a readable format
    strConvertDT = CDate(Mid(strDateTime, 5, 2) & "/" &_
                    Mid(strDateTime, 7, 2) & _
                    "/" & Left(strDateTime, 4) & " " &_
                    Mid (strDateTime, 9, 2) & ":" & _
                    Mid(strDateTime, 11, 2) & ":" & _
                    Mid(strDateTime, 13, 2))
    dtConvert = strConvertDT
End Function

'******************************************************************************
' Get File Attribute "Owner"
'******************************************************************************
Function GetOwner(strFile)
' When processing multiple files make the WMI Local Computer Object Global!
' (Move outside the Function)

'strComputer = "."
'Set objWMIService = GetObject("winmgmts:" _ 
'     & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 

Set objCollection = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_LogicalFileSecuritySetting='" & strFile _
& "'} WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner")

For Each objSID in objCollection
GetOwner = objSID.AccountName
Next

If VarType(GetOwner) = 0 Then
GetOwner = "error"
End If
End Function


'******************************************************************************
' Convert Standard DateTime to WMI DateTime Function
'******************************************************************************
Function ConvDateTimeWMI(strDateTime)
set oswbemdtm=createobject("wbemscripting.swbemdatetime")
    oswbemdtm.setvardate strDateTime,true 'CONVERT_TO_LOCAL_TIME=true
    ConvDateTimeWMI = oswbemdtm
set oswbemdtm = Nothing
End Function


'******************************************************************************
' Prompt User for Drive Letter to search.
'******************************************************************************
Function funDriveSelect()
Const TimeOut = 10
 strDriveSelect=UCase(InPutBox("Enter Drive Letter", "Search Drive", "O")) 
    If strDriveSelect = "" Then
     intReturn = objShell.Popup("No User Input Found." & vbCrLf &_
                                "Would you like to Retry?" ,TimeOut, _
                                "Information Window", vbYesNo)
        Select CASE intReturn
                Case 1
'                    Wscript.Echo "You clicked the OK button."
                Case 2
'                    Wscript.Echo "You clicked the CANCEL button."
                     Wscript.Quit
                Case 3
'                    Wscript.Echo "You clicked the ABORT button."
                Case 4
'                    Wscript.Echo "You clicked the RETRY button."
                     subDriveSelect()
                Case 5
'                    Wscript.Echo "You clicked the IGNOR button."
                Case 6
'                    Wscript.Echo "You clicked the YES button."
                     subDriveSelect()
                Case 7
'                    Wscript.Echo "You clicked the NO button."
                     Wscript.quit
                Case Else
'                    Wscript.echo "PopUp Timed Out!!"
                     Wscript.quit
        End Select
    End If
    funDriveSelect = strDriveSelect
End Function

'******************************************************************************
' Prompt User for File Extention to search for.
'******************************************************************************
Function funFileExtention() 
 strFileExtension=UCase(InPutBox("Enter File Name Extension to search for.", _
		"File Extension Search", "MDB")) 
    If strFileExtension = "" Then
     intReturn = objShell.Popup("No User Input Found." & vbCrLf &_
                                "Would you like to Retry?" ,TimeOut, _
                                "Information Window", vbYesNo)
        Select CASE intReturn
                Case 1
'                    Wscript.Echo "You clicked the OK button."
                Case 2
'                    Wscript.Echo "You clicked the CANCEL button."
                     Wscript.Quit
                Case 3
'                    Wscript.Echo "You clicked the ABORT button."
                Case 4
'                    Wscript.Echo "You clicked the RETRY button."
                     subDriveSelect()
                Case 5
'                    Wscript.Echo "You clicked the IGNOR button."
                Case 6
'                    Wscript.Echo "You clicked the YES button."
                     subDriveSelect()
                Case 7
'                    Wscript.Echo "You clicked the NO button."
                     Wscript.quit
                Case Else
'                    Wscript.echo "PopUp Timed Out!!"
                     Wscript.quit
        End Select
    End If
    funFileExtention = strFileExtension
End Function							

'******************************************************************************
' Prompt User for Date and Time to search for.
'******************************************************************************
Function funDateInput()
 strDate=InPutBox("Enter beginning Date and Time for Search." & VBcrlf & _
        VBcrlf & "Ending Date and Time will be: " & vbCrLf &_
        "                    " & Date() & " 12:00 AM", _
		"Date Range Search", datevalue(dateadd("m",-1,Now())) _
		& " 12:00 AM")
    If strDate = "" Then
     intReturn = objShell.Popup("No User Input Found." & vbCrLf &_
                                "Would you like to Retry?" ,TimeOut, _
                                "Information Window", vbYesNo)
        Select CASE intReturn
                Case 1
'                    Wscript.Echo "You clicked the OK button."
                Case 2
'                    Wscript.Echo "You clicked the CANCEL button."
                     Wscript.Quit
                Case 3
'                    Wscript.Echo "You clicked the ABORT button."
                Case 4
'                    Wscript.Echo "You clicked the RETRY button."
                     subDriveSelect()
                Case 5
'                    Wscript.Echo "You clicked the IGNOR button."
                Case 6
'                    Wscript.Echo "You clicked the YES button."
                     subDriveSelect()
                Case 7
'                    Wscript.Echo "You clicked the NO button."
                     Wscript.quit
                Case Else
'                    Wscript.echo "PopUp Timed Out!!"
                     Wscript.quit
        End Select
        funDateInput = strDate
    End If
End Function

Thanks

John Fuhrman
faq329-6766
faq329-7301
thread329-1334328
thread329-1424438