Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Option Explict ??

Status
Not open for further replies.

sparkbyte

Technical User
Sep 20, 2002
879
US
I have a script that works great without the option explict, but when it is added and all objects and variables declared it stops outputing the file results to Excel.

Any Ideas?? I have messed with it for 2 days now. I suspect it has something to do with the Sub and Functions but do not know.

Thanks. Here is the code.

Code:
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
' 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)
'    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.
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

'Option Explicit

'******************************************************************************
'****                                                                      ****
'****                     Start of Main Script                             ****
'****                                                                      ****
'******************************************************************************
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.
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.
'******************************************************************************
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
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"

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

'******************************************************************************
' Search for user specified files
'******************************************************************************
On Error Resume Next
 
 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 = 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
On Error GoTo 0

'******************************************************************************
'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 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


Thanks

John Fuhrman
 
Comment out all the On Error Resume Next statements so you can see the error messages.
 
A quick scan suggests that strOwner is not declared.
 
Thanks Tsuji, Declared strOwner and found one other.
colFiles.

Uncommented the On Error Resume Next instances and the On Error GoTo 0.

Script completes without any errors but only writes out 1 row that is empty exept for the user Unknown when there should be 12 rows written.

Any ideas??

Thanks!!!!

Thanks

John Fuhrman
 
It can take quite a (long?) while to complete and/or taking in wildcard extension if not careful. cim_datafile is a monster. Other than that, it should write and save at least just fine.
 
Well here is the latest version.

Everything works great as long as option explicit is not declared.


Code:
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
' 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)
'    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                              <><>
'<><>                                                                      <><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>
'<><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><><>

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 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 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


Thanks

John Fuhrman
 
You missed declaring objFile. But frankly, didn't you see that error message when you ran your code with "Option Explicit"?
 
No it didn't error out, it just never filled in the owner detail and quit after the first record.

Declaring objFile finally did it!!!

Couldn't see my own nose, despite my face. I have lost count how many time I have gone through this code looking for missed declarations. I was sure it had to be a missed declaration but couldn't find it. I gues I have stared at it too much and was just looking past it.

THANKS



Thanks

John Fuhrman
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top