I have a script that creates an Excel spreadsheet of all the files found on a given drive filtered by extension.
This script arose out of a need to create a report of all Access Applications on the public shares.
Problem is this.
The user prompts are going through the do loop twice for each user input.
Thanks
John Fuhrman
Titan Global Services
faq329-6766
This script arose out of a need to create a report of all Access Applications on the public shares.
Problem is this.
The user prompts are going through the do loop twice for each user input.
Code:
'-----------------------------------------------------------------
'-----------------------------------------------------------------
' Script: File Extension Report to Excel
' Author: John Fuhrman
' Date: 2009-10-29
' Description: This script will prompt for the drive letter and
' file extension that will be searched for and outputs the
' results into an Excel spreadsheet
'-----------------------------------------------------------------
'-----------------------------------------------------------------
DriveSelect()
Do While strDrive = ""
If strDrive = "" Then
strDriveErr=MsgBox("Drive Letter Not Entered",69,"Missing Parameter")
Select Case strDriveErr
Case vbOK
' wscript.echo = "OK was clicked"
Case vbCancel
' wscript.echo "Cancel was clicked"
wscript.quit
Case vbAbort
' wscript.echo "Abort was clicked"
DriveSelect()
Case vbRetry
' wscript.echo "Retry was clicked"
DriveSelect()
Case vbIgnore
' wscript.echo "Ignore was clicked"
Case vbYes
' wscript.echo "Yes was clicked"
Case vbNo
' wscript.echo "No was clicked"
Case Else
wscript.echo "Do Over"
DriveSelect()
End Select
End If
Loop
FileExtension()
Do While strExtension = ""
If strExtension = "" Then
strExtensionErr=MsgBox("File Extension Not Entered",69,"Missing Parameter")
Select Case strExtensionErr
Case vbOK
' wscript.echo = "OK was clicked"
Case vbCancel
' wscript.echo "Cancel was clicked"
wscript.quit
Case vbAbort
' wscript.echo "Abort was clicked"
FileExtension()
Case vbRetry
' wscript.echo "Retry was clicked"
FileExtension()
Case vbIgnore
' wscript.echo "Ignore was clicked"
Case vbYes
' wscript.echo "Yes was clicked"
Case vbNo
' wscript.echo "No was clicked"
Case Else
wscript.echo "Do Over"
DriveSelect()
End Select
End If
Loop
strComputer = "." ' use "." for local computer
' Spreadsheet file to be created.
strExcelPath = strDrive & "-Access_Application_Listing.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
' Create a new workbook.
objExcel.Workbooks.Add
' Bind to worksheet.
Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1)
objWorksheet.Name = "Settings Report"
' Populate spreadsheet cells with user attributes.
objWorksheet.Cells(1, 1).Value = "Access Application Name"
objWorksheet.Cells(1, 2).Value = "Drive"
objWorksheet.Cells(1, 3).Value = "Location"
objWorksheet.Cells(1, 4).Value = "File Size"
objWorksheet.Cells(1, 5).Value = "Can be Archived or Deleted"
objWorksheet.Cells(1, 6).Value = "Point of Contact"
objWorksheet.Cells(1, 7).Value = "POC Contact Number"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService. _
ExecQuery("Select * from CIM_DataFile" _
& " where Drive=" & "'" & Ucase(strDrive) & ":' and Extension='" &_
Ucase(strExtension) & "'")
' WScript.Echo "# of files found: " & colFiles.Count
intCounter = 0
k = 2
For Each objFile in colFiles
objWorksheet.Cells(k, 1).Value = objFile.FileName
objWorksheet.Cells(k, 2).Value = objFile.Drive
objWorksheet.Cells(k, 3).Value = objFile.Path
objWorksheet.Cells(k, 4).Value = objFile.FileSize
objWorksheet.Cells(k, 5).Value = ""
objWorksheet.Cells(k, 6).Value = ""
objWorksheet.Cells(k, 7).Value = ""
objWorksheet.Cells(k, 8).Value = ""
k = k + 1
Next
' Format the spreadsheet.
objWorksheet.Range("A1:Z1").Font.Bold = True
Set objRange = objWorksheet.UsedRange
objRange.EntireColumn.Autofit()
Const xlAscending = 1
Const xlDescending = 2
Const xlYes = 1
Set objRange = objWorksheet.UsedRange
Set objRange2 = objExcel.Range("B1") 'Sort by Drive'
Set objRange3 = objExcel.Range("C1") 'Sort by Path'
objRange.Sort objRange2, xlAscending, , , , , , xlYes
objRange.Sort objRange3, xlAscending, , , , , , xlYes
' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
' Quit Excel.
objExcel.Application.Quit
Function DriveSelect()
strDrive=InPutBox("Enter Drive Letter:","Search Drive")
End Function
Function FileExtension()
strExtension=InPutBox("Enter File Name Extension to search for.","File Extension Search","MDB")
End Function
Thanks
John Fuhrman
Titan Global Services
faq329-6766