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 gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Help with user prompted input loop

Status
Not open for further replies.

sparkbyte

Technical User
Sep 20, 2002
879
US
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.

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
 
OK, found it. Figures.....

Forgot to to take out the for next loop after changing the error handling to a case statement.

Sorry folks.

Thanks

John Fuhrman
Titan Global Services
faq329-6766
 
Well I spoke too soon.

If you enter a drive letter it still hits the error handler (select case) and reports no drive letter. Hit retry and the 2nd time it works.

Same on the File Extension.

Thanks in advance for the help.



Thanks

John Fuhrman
Titan Global Services
faq329-6766
 
Declare you variables explicitly, so there is no confusion about the scope. That is, add
Code:
Dim strDrive
as the first line to fix this particular problem.

I strongly recommend using
Code:
Option Explicit
at the top of your script. See here for a brief explanation.
 
Got it.

Now to clean up the code.

Option explicit

and setting all variables to "" and closing all opened objects before closing script.

Thanks

Thanks

John Fuhrman
Titan Global Services
faq329-6766
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top