Link to home
Start Free TrialLog in
Avatar of BlizzardMN
BlizzardMNFlag for United States of America

asked on

VB Script to search multiple folders for specific file type

I have a script that will search a drive letter for a specified file type and export the results to a csv file.  I like how all the current formatting is with the csv file listing location, size, date created, ect. but here is what I need to be able to do and need a little help and direction.

I have voice files out in some of our network user folders that we need to find easily sometimes on a regular basis.  I don't want to search the whole user directory share since that would be to huge to do.  I would like to have a text file with a list of usernames(folder paths) that the script would reference to search those folders only or folders like those using a wildcard.

I hope that makes sense!  Here is my current code.
On error Resume Next
 
Dim oWmi
Dim oRef
Dim fso,f

strFileName = "FoundUserFiles"

'file extension type to look for 
strType="dss"

'drive letter to search
strDrive="F:"

'output location of the csv file 
strOutput="c:\test2\" & strFileName & ".csv"
 
strQuery="Select Name,CreationDate,LastAccessed,LastModified," & _
"FileSize,Extension,Drive FROM CIM_DATAFILE WHERE Extension='" & strType & _
 "' AND Drive='" & strDrive & "'"
 
Set fso=CreateObject("Scripting.FileSystemObject")
 If fso.FileExists(strOutput) Then fso.DeleteFile(strOutput)
Set f=fso.CreateTextFile(strOutput)
 If Err.Number Then
  wscript.echo "Could not create output file " & strOutput
  wscript.quit
 End If
 
Set oWmi=GetObject("winmgmts:")
If Err.Number Then
  strErrMsg= "Error connecting to WINMGMTS" & vbCrlf
  strErrMsg= strErrMsg & "Error #" & err.number & " [0x" & CStr(Hex(Err.Number)) &"]" & vbCrlf
        If Err.Description = "" Then
            strErrMsg = strErrMsg & "Error description: " & Err.Description & "." & vbCrlf
        End If
  Err.Clear
  wscript.echo strErrMsg
  wscript.quit
End If
 
Set oRef=oWmi.ExecQuery(strQuery) 
If Err.Number Then
  strErrMsg= "Error connecting executing query!" & vbCrlf
  strErrMsg= strErrMsg & "Error #" & err.number & " [0x" & CStr(Hex(Err.Number)) &"]" & vbCrlf
        If Err.Description = "" Then
            strErrMsg = strErrMsg & "Error description: " & Err.Description & "." & vbCrlf
        End If
  Err.Clear
  wscript.echo strErrMsg
  wscript.quit
End If

 
f.Writeline "FilePath,Size(bytes),Created,LastAccessed,LastModified"
 
For Each file In oRef
 f.Writeline file.Name & "," & file.FileSize & "," & ConvWMITime(file.CreationDate) & _
  "," & ConvWMITime(file.LastAccessed) & "," & ConvWMITime(file.LastModified)
Next
 
f.Close
 
'wscript.echo "Finished.  See " & strOutput & " for results"
 
Set oWmi=Nothing
Set oRef=Nothing
Set fso=Nothing
Set f=Nothing
 
wscript.quit
 
'************************************************************************************
' Convert WMI Time Function
'************************************************************************************
Function ConvWMITime(wmiTime)
On Error Resume Next
 
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
 
'EOF

Open in new window

Avatar of BlizzardMN
BlizzardMN
Flag of United States of America image

ASKER

Ok, I have modified the code to at least search one path but I am not sure how I can make it search more than one path.  What I want to do is map the users folder to a drive then search certain folders in that drive based on a text file or some sort of string of folder names.

I have strPath="%\\test\\hall%\\"  and WHERE Path Like '" & strPath in the code to search any folders starting with hall in the test folder.  How can I make it search multiple paths?  This could end up being more than 50.  I could be way off or over thinking this but here is my latest code and thanks for any help.
On error Resume Next

Dim objShell: Set objShell=CreateObject("Wscript.Shell") 
Dim oWmi
Dim oRef
Dim fso,f

strComputer = "."
Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor")
For Each objItem in colItems
    intHorizontal = objItem.ScreenWidth
    intVertical = objItem.ScreenHeight
Next

Set objExplorer = CreateObject _
    ("InternetExplorer.Application")

objExplorer.Navigate "about:blank"   
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Left = (intHorizontal - 400) / 2
objExplorer.Top = (intVertical - 200) / 2
objExplorer.Width = 400
objExplorer.Height = 200 
objExplorer.Visible = 1             

objExplorer.Document.Body.Style.Cursor = "wait"

objExplorer.Document.Title = "Search for dss files in progress"
objExplorer.Document.Body.InnerHTML = "<img src='file:///C:\test\circle.gif'> " & _
    "The script is being processed. This might take several minutes to complete."

strTitle="File Type Search"
strType=InputBox("What type of file do you want to look for? Do NOT use a period.",strTitle,"dss")
 If strType="" Then 
  wscript.echo "Nothing entered or you cancelled"
  wscript.quit
 End If 
strDrive=InputBox("What drive do you want to search?  Do NOT use a trailing ",strTitle,"c:")
 If strDrive="" Then
  wscript.echo "Nothing entered or you cancelled"
  wscript.quit
 End If 
 
'trim strDrive just in case the user added a 
strDrive=Left(strDrive,2)
 
strOutput=InputBox("Enter full path and filename for the CSV file.  Existing files will " & _
"be overwritten.",strTitle,"c:\" & strType & "-query.csv")
 If strOutput="" Then
 wscript.echo "Nothing entered or you cancelled"
  wscript.quit
 End If 

strPath="%\\test\\hall%\\"

'output location of the csv file 
'strOutput="c:\test2\" & strFileName & ".csv"
 
strQuery="Select Name,CreationDate,LastAccessed,LastModified," & _
"FileSize,Extension,Drive FROM CIM_DATAFILE WHERE Path Like '" & strPath & "' AND Extension='" & strType 

& _
 "' AND Drive='" & strDrive & "'"
 
Set fso=CreateObject("Scripting.FileSystemObject")
 If fso.FileExists(strOutput) Then fso.DeleteFile(strOutput)
Set f=fso.CreateTextFile(strOutput)
 If Err.Number Then
  wscript.echo "Could not create output file " & strOutput
  wscript.quit
 End If
 
Set oWmi=GetObject("winmgmts:")
If Err.Number Then
  strErrMsg= "Error connecting to WINMGMTS" & vbCrlf
  strErrMsg= strErrMsg & "Error #" & err.number & " [0x" & CStr(Hex(Err.Number)) &"]" & vbCrlf
        If Err.Description = "" Then
            strErrMsg = strErrMsg & "Error description: " & Err.Description & "." & vbCrlf
        End If
  Err.Clear
  wscript.echo strErrMsg
  wscript.quit
End If
 
Set oRef=oWmi.ExecQuery(strQuery) 
If Err.Number Then
  strErrMsg= "Error connecting executing query!" & vbCrlf
  strErrMsg= strErrMsg & "Error #" & err.number & " [0x" & CStr(Hex(Err.Number)) &"]" & vbCrlf
        If Err.Description = "" Then
            strErrMsg = strErrMsg & "Error description: " & Err.Description & "." & vbCrlf
        End If
  Err.Clear
  wscript.echo strErrMsg
  wscript.quit
End If

'objShell.Popup "Working....you will get a finished message when done", 5 
f.Writeline "FilePath,Size(bytes),Created,LastAccessed,LastModified"
 
For Each file In oRef
 f.Writeline file.Name & "," & file.FileSize & "," & ConvWMITime(file.CreationDate) & _
  "," & ConvWMITime(file.LastAccessed) & "," & ConvWMITime(file.LastModified)
Next
 
f.Close

objExplorer.Document.Body.InnerHTML = "The script is now done searching."
objExplorer.Document.Body.Style.Cursor = "default"

'Wscript.Sleep 5000

wscript.echo "Finished.  See " & strOutput & " for results"

objExplorer.Quit 
 
Set oWmi=Nothing
Set oRef=Nothing
Set fso=Nothing
Set f=Nothing
 
wscript.quit
 
'************************************************************************************
' Convert WMI Time Function
'************************************************************************************
Function ConvWMITime(wmiTime)
On Error Resume Next
 
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
 
'EOF

Open in new window

Here is some code that will open a text file (c:\paths.txt) and will loop through it.  The current itteration of whatever line it's on will be stored in the variable sText.  You can put the code you want to do to each path inside the second IF statement.

If you had a file that contained the following:

\\server\share\user\music
\\server\share\user\documents

On the first go around, sText would = the first line and the next time through the loop it would equal the second line.  You can go in and enter in all the paths that you want searched and it will cycle through them one by one doing whatever the rest of your code tells it to.

I hope that makes sense...
Set oFSO = CreateObject("Scripting.FileSystemObject") 
sFile = "c:\paths.txt" 
If oFSO.FileExists(sFile) Then  
	Set oFile = oFSO.OpenTextFile(sFile, 1)   
		Do While Not oFile.AtEndOfStream    
			sText = oFile.ReadLine     
				If Trim(sText) <> "" Then      
					WScript.Echo sText     
				End If   
			Loop  
		oFile.Close 
End If

Open in new window

Yes that does make sense.  I won't be able to do more testing of this script until Saturday but will post my results when I do.  Thanks for the help!
ASKER CERTIFIED SOLUTION
Avatar of RobSampson
RobSampson
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
I did a little testing this morning and the array changes Rob made worked well.  I think the array instead of the extra external txt file will work for me.  Thanks!
Another question stolen out from underneath me by Rob!  :)
Ha ha, sorry Jared......I had something similar in my library anyway, so I just grabbed it.

Thanks for the grade.

Regards,

Rob.
Avatar of stefanjoc
stefanjoc

Hi folks.  This is perfect for what I need it for, however it seems to run find but when I open the csv file all I have is headings and no content?  What am I missing, the code is unchanged from Robs code. :-)
Hi again.  so close to getting this working lol.  What I also want to do, is just create one file so I want the searching  of multiple paths to append to the file?  In the file, as well as the headers you have predefined such as size, last accessed etc, I want the username of the user that is currently logged on.  For a bit of background, I want to run this at logon for all my users so that it scans thier machines for different file types and write back to a text file that I can then search?
Hi, this should already append to the same file for multiple paths during one script run, because the query states
WHERE Path LIKE '%\\scripting\\%' OR Path LIKE '\\Office %\\%'

so it actually performs the multiple path search in the same query.
The script does, however, overwrite the same each separate time the script is run.

It appears to be now finding the files in those specified paths for me.  I placed a file in a folder called scripting and it picked it up fine.

Regards,

Rob.

On Error Resume Next 
 
Dim objShell: Set objShell=CreateObject("Wscript.Shell")  
Dim oWmi 
Dim oRef 
Dim fso,f 
 
strComputer = "." 
Set objWMIService = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2") 
Set colItems = objWMIService.ExecQuery("Select * From Win32_DesktopMonitor") 
For Each objItem In colItems 
    intHorizontal = objItem.ScreenWidth
    intVertical = objItem.ScreenHeight
Next 
If IsNull(intHorizontal) Then intHorizontal = 800
If IsNull(intVertical) Then intVertical = 400
Set objExplorer = CreateObject("InternetExplorer.Application")
objExplorer.Navigate "about:blank"    
objExplorer.Visible = 1
objExplorer.ToolBar = 0
objExplorer.StatusBar = 0
objExplorer.Top = (intVertical - 200) / 2
objExplorer.Left = (intHorizontal - 400) / 2
objExplorer.Width = 400
objExplorer.Height = 200

objExplorer.Document.Body.Style.Cursor = "wait"

objExplorer.Document.Title = "Search for dss files in progress"
objExplorer.Document.Body.InnerHTML = "<img src='file:///C:\test\circle.gif'> " & _ 
    "The script is being processed. This might take several minutes to complete."

Err.Clear
strTitle="File Type Search"
strType=InputBox("What type of file do you want to look for? Do NOT use a period.",strTitle,"dss")
If strType="" Then
	wscript.echo "Nothing entered or you cancelled"
	wscript.quit
End If
strDrive=InputBox("What drive do you want to search?  Do NOT use a trailing ",strTitle,"c:") 
If strDrive="" Then
	wscript.echo "Nothing entered or you cancelled" 
	wscript.quit 
End If  

'trim strType just in case the user added a dot
If Left(strType, 1) = "." Then strType = Mid(strType, 2)
  
'trim strDrive just in case the user added a  
strDrive=Left(strDrive,2)

strOutput=InputBox("Enter full path and filename for the CSV file.  Existing files will " & _ 
"be overwritten.",strTitle,Replace(WScript.ScriptFullName, WScript.ScriptName, "") & strType & "-query.csv") 
If strOutput="" Then 
	wscript.echo "Nothing entered or you cancelled" 
	wscript.quit 
End If  
 
arrPaths = Array( _
	"%\scripting\%", _
	"%\Office %\%" _
	)
 
'output location of the csv file  
'strOutput="c:\test2\" & strFileName & ".csv" 

strPathQuery = "AND"
For Each strPath In arrPaths
	If strPathQuery = "AND" Then
		strPathQuery = strPathQuery & " (Path Like '" & Replace(strPath, "\", "\\") & "'"
	Else
		strPathQuery = strPathQuery & " OR Path Like '" & Replace(strPath, "\", "\\") & "'"
	End If
Next
strPathQuery = strPathQuery & ")"

strQuery="Select Name,CreationDate,LastAccessed,LastModified,FileSize,Extension,Drive FROM CIM_DATAFILE WHERE Extension='" & strType & "' AND Drive='" & strDrive & "' " & strPathQuery

Set fso=CreateObject("Scripting.FileSystemObject") 
If fso.FileExists(strOutput) Then fso.DeleteFile(strOutput) 
Set f=fso.CreateTextFile(strOutput, True)
If Err.Number Then
	wscript.echo "Could not create output file " & strOutput & VbCrLf & "Err number: " & Err.Number & VbCrLf & "Err description: " & Err.Description
	wscript.quit 
End If 

Set oWmi=GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
If Err.Number Then
	strErrMsg= "Error connecting to WINMGMTS" & vbCrlf
	strErrMsg= strErrMsg & "Error #" & err.number & " [0x" & CStr(Hex(Err.Number)) &"]" & vbCrlf
	If Err.Description <> "" Then
		strErrMsg = strErrMsg & "Error description: " & Err.Description & "." & vbCrlf
	End If
	Err.Clear
	wscript.echo strErrMsg
	wscript.quit
End If

Set oRef=oWmi.ExecQuery(strQuery)
If Err.Number Then
	strErrMsg= "Error connecting executing query!" & vbCrlf 
	strErrMsg= strErrMsg & "Error #" & err.number & " [0x" & CStr(Hex(Err.Number)) &"]" & vbCrlf 
	If Err.Description <> "" Then 
		strErrMsg = strErrMsg & "Error description: " & Err.Description & "." & vbCrlf 
	End If 
	Err.Clear 
	wscript.echo strErrMsg 
  	wscript.quit 
End If 
 
'objShell.Popup "Working....you will get a finished message when done", 5  
f.Writeline "FilePath,Size(bytes),Created,LastAccessed,LastModified"   
For Each file In oRef
	f.Writeline file.Name & "," & file.FileSize & "," & ConvWMITime(file.CreationDate) & _ 
	"," & ConvWMITime(file.LastAccessed) & "," & ConvWMITime(file.LastModified) 
Next 
  
f.Close 
 
objExplorer.Document.Body.InnerHTML = "The script is now done searching." 
objExplorer.Document.Body.Style.Cursor = "default" 
 
'Wscript.Sleep 5000 
 
wscript.echo "Finished.  See " & strOutput & " for results" 
 
objExplorer.Quit  
  
Set oWmi=Nothing 
Set oRef=Nothing 
Set fso=Nothing 
Set f=Nothing 
  
wscript.quit 
  
'************************************************************************************ 
' Convert WMI Time Function 
'************************************************************************************ 
Function ConvWMITime(wmiTime) 
On Error Resume Next 
  
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 
  
'EOF

Open in new window

The script works great for what I needed it for.  I am now wondering what kind of modifications it would take to get this to work for unc paths?  Instead of searching a single drive letter I want to list computer names or names plus a specific foler in the array and search and output results.  

Something like this but this doesn't appear to work.

arrPaths = Array( _
      "%\\HB12065B\c$\VXPBackup\%", _
      "%\\HB12065B\c$\VXPDownload\%" _
      )

Any help is appreciated.
Hi BlizzardMN,

For remote file searches, you would be better off parsing each string in the array, so that strComputer became the computer name, strDrive became the local drive, and the rest of the path became a path local to that computer.

For example, if you had:
"\\HB12065B\c$\VXPBackup\%"

in the array, you could use

For Each strPath In arrPaths
      If Left(strPath, 2) = "\\" Then
            strComputer = Split(strPath, "\")(2)
            strDrive = Replace(Split(strPath, "\")(3), "$", ":")
            strLocalPath = Mid(strPath, Len("\\" & strComputer & "\" & strDrive & "\") + 1)
            ' Then connect to each computer and construct the CIM_DATAFILE query
      End If
Next

and where the comment is in the above snippet, you would query that remote computer.

The whole structure would be quite different.  If you want me to help you further with that, post a new question, and post the link to it here, and I'll have a look.

Regards,

Rob.