'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
' 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/8/2010 - John Fuhrman
'       Added coments to code by sections.
'       Converted user prompts to Functions.
'       Added File Extension
'    2/19/2010 - John Fuhrman
'       Added Date to filename.   
'   3/5/2010
'       Decared all objects and variables and added
'       a cleanup section to the end of the script.
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><>                                                                      <><>
'<><>                    Start of Main Script                              <><>
'<><>                                                                      <><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

Option Explicit

Dim strComputer, objWMIService, objShell
strComputer = "."     ' use "." for local computer

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

Set objShell = CreateObject("Wscript.Shell")

'******************************************************************************
' Prompted User Input
'******************************************************************************
Dim strDrive, strExtension
strDrive     = funDriveSelect

strExtension = funFileExtention

'strDateInput = funDateInput

'******************************************************************************
' Create Spreadsheet and Open Excel
'******************************************************************************
Dim strExcelPath, objExcel, objWorksheet

' 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.
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
  Wscript.Echo "Excel application not found."
  Wscript.Quit
End If

'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.
'******************************************************************************
Dim objRange, objRange1, objRange2, objRange3, objRange4
Dim objRange5, objRange6, objRange7, objRange8, objRange9

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 (Folder)
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

'******************************************************************************
' Format FileSize with Commas
'******************************************************************************
    objRange6.EntireColumn.NumberFormat = "#,##0"
    objRange7.EntireColumn.NumberFormat = "mm/dd/yyyy hh:mm;@"
    objRange8.EntireColumn.NumberFormat = "mm/dd/yyyy hh:mm;@"
    
'******************************************************************************
'Autofit all columns
'******************************************************************************
    objRange.EntireColumn.Autofit()
   
'******************************************************************************
' Search for user specified files
'******************************************************************************
 Dim colFiles
 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
'******************************************************************************
Dim objFile, strOwner
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 = LCase(objFile.Extension)            'C
    objWorksheet.Cells(k,4).Value = UCase(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
'******************************************************************************
Dim strFileCountMSG, StrFileCount, k
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

'******************************************************************************
' Clean up Objects and Variables we created.
'******************************************************************************

Set objExcel = Nothing
Set objWMIService = Nothing
Set objShell = Nothing
Set objWorksheet = Nothing
Set colFiles = Nothing
Set objFile = Nothing
Set objRange = Nothing
Set objRange1 = Nothing
Set objRange2 = Nothing
Set objRange3 = Nothing
Set objRange4 = Nothing
Set objRange5 = Nothing
Set objRange6 = Nothing
Set objRange7 = Nothing
Set objRange8 = Nothing
Set objRange9 = Nothing

strComputer = Null
strDrive = Null
strExtension = Null
strExcelPath = Null
k = Null
StrFileCount = Null
strFileCountMSG = Null


'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><>                                                                      <><>
'<><>               Start of Subroutines and Functions                     <><>
'<><>                                                                      <><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

'******************************************************************************
' Convert WMI Time Function
'******************************************************************************
Public Function ConvWMITime(wmiTime)
Dim yr, mo, dy, tm
 
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
'******************************************************************************
Public Function dtConvert(strDateTime)
Dim strConvertDT
' 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"
'******************************************************************************
Public Function GetOwner(strFile)
Dim objCollection, objSID
On Error Resume Next
' 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

On Error GoTo 0
End Function

'******************************************************************************
' Convert Standard DateTime to WMI DateTime Function
'******************************************************************************
Public Function ConvDateTimeWMI(strDateTime)
Dim oswbemdtm
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.
'******************************************************************************
Public Function funDriveSelect()
Dim strDriveSelect, intReturn
Const TimeOut = 20

 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.
'******************************************************************************
Public Function funFileExtention()
Dim strFileExtension, intReturn
Const TIMEOUT = 20  ' Constant set for User prompt timeout

 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.
'******************************************************************************
Public Function funDateInput()
Dim strDate, intReturn
Const TIMEOUT = 20  ' Constant set for User prompt timeout

 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

'******************************************************************************
' Icons for objShell.Popup
'******************************************************************************
'   STOP                        vbCritical                  16
'   QUESTION MARK               vbQuestion                  32
'   EXCLAMATION MARK            vbExclamation               48
'   INFORMATION                 vbInformation               64
'******************************************************************************
' Button Set for objShell.Popup
'******************************************************************************
'   OK                          vbOKOnly                    0
'   OK and CANCEL               vbOKCancel                  1
'   ABORT, RETRY and IGNORE     vbAbortRetryIgnore          2
'   YES, NO and CANCEL          vbYesNoCancel               3
'   YES and NO                  vbYesNo                     4
'   RETRY and CANCEL            vbRetryCancel               5
'******************************************************************************
' Default Buttons for objShell.Popup
'******************************************************************************
'   LEFT                        vbDefaultButton1            0
'   MIDDLE                      vbDefaultButton2            256
'   RIGHT                       vbDefaultButton3            512
'******************************************************************************
' Buttons Values for objShell.Popup
'******************************************************************************
'   1       VbOK        OK
'   2       VbCancel    Cancel
'   3       VbAbort     Abort
'   4       VbRetry     Retry
'   5       VbIgnore    Ignore
'   6       VbYes       Yes
'   7       VbNo        No