How can I list all files with Extension XXX to an Excel Spreadsheet

'==========================================================================
'
' 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=InPutBox("Enter Drive Letter", "Search Drive", "O") 
 strExtension=InPutBox("Enter File Name Extension to search for.", "File Extension Search", "MDB") 
 
 ' 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.Visible = False   'Set this True if you would like to see the Spreadsheet being updated.
objExcel.Workbooks.Add

' Bind to worksheet.
Set objWorksheet = objExcel.ActiveWorkbook.Worksheets(1)
objWorksheet.Name = "File Listing for " & 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 = "Date Created"                     'Cell E1
objWorksheet.Cells(1, 6).Value = "Date Last Modified"               'Cell F1
objWorksheet.Cells(1, 7).Value = "Point of Contact"                 'Cell G1
objWorksheet.Cells(1, 8).Value = "POC Contact Number"               'Cell H1

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

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

intCounter = 0
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 = dtConvert(objFile.CreationDate)   'E
            objWorksheet.Cells(k, 6).Value = dtConvert(objFile.LastModified)   'G
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
'=============================================================================
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

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

Sub Add2Log(txt) ' txt is the text we deliver into the sub  
Dim fso
Set fso = CreateObject("scripting.filesystemobject")

' Declare the log file name  
Myfile = "MyLogFile.Log"

' Open it for Append  
Const ForAppending = 8 ' Append mode  
' Declare the FileSystemObject and File variables 
      
' Create a new FileSystemObject object  
Set fso = CreateObject("Scripting.FileSystemObject")
' Open the file and force creation, if it doesn't exist already  
Set file = fso.OpenTextFile(MyFile, ForAppending, TRUE)
file.WriteLine (txt) ' append log  
' Clean up  
Set file = Nothing 
Set fso = Nothing 
End Sub