×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

VBScript FAQ

File and Data Processing

How can I list all files with Extension XXX to an Excel Spreadsheet by sparkbyte
Posted: 22 Jan 10

This is a script I wrote because I find myself needing to know where all the Access DB files are on a given drive.

I have seem many questions on how to search for and report on files by extension so I tried to make this as universal as possible.

Hope you find it usefull.


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.
'
'==========================================================================
 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

Back to VBScript FAQ Index
Back to VBScript Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close