[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2094
  • Last Modified:

Search subfolders with a VBScript

I have the following script that works very well to pull out the basic info from one directory.

Now the problem is that I need to go after a folder like C:\Program Files\Business Objects and all its sub folders.

I have two apps that are apparently cross linking on their version Crystal -- I need to get the raft of subdirectories and the files and versions.
strComputer = "10.xx.x.xxx"
 
strOutputFile = "./" & Split(WScript.ScriptName, ".")(0) & "_" & Hour(Now) & "_" & Minute(Now) & ".txt"
 
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, TRUE)
 
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
 
Set colFileList = objWMIService.ExecQuery _
    ("ASSOCIATORS OF {Win32_Directory.Name='C:\Windows\System32'} Where " _
        & "ResultClass = CIM_DataFile")
 
strmsg = "File_Name" & vbTAB & "File_Type" & vbTAB & "File_Size" & vbTAB & "File_Version" & vbTAB & _
       "Manufacturer" & vbTAB & "Readable_Attr" & vbTAB & "Writeable_Attr" & vbTAB & "Hidden_Attr" & vbTAB & _
       "System_Attr" & vbTAB & "Archive_Attr" & vbTAB & "Encrypted_Attr" & vbTAB & "Compressed_Attr" & vbTAB & _
       "Created_Date" & vbTAB & "Installed_Date" & vbTAB & "Last_Accessed" & vbTAB & "Last_Modified"
objOutputFile.WriteLine (strmsg)
strmsg = ""
 
'I=0
For Each objFile In colFileList
    If (objFile.Extension = "dll" or  objFile.Extension = "exe")   Then
        strmsg=""
        strmsg = strmsg &objfile.name
        strmsg = strmsg &  vbTAB & objfile.filetype
        strmsg = strmsg &  vbTAB & objfile.filesize
        strmsg = strmsg &  vbTAB & objfile.version
        strmsg = strmsg &  vbTAB & objfile.manufacturer
        strmsg = strmsg &  vbTAB & objfile.readable
        strmsg = strmsg &  vbTAB & objfile.writeable
        strmsg = strmsg &  vbTAB & objfile.hidden
        strmsg = strmsg &  vbTAB & objfile.system
        strmsg = strmsg &  vbTAB & objfile.archive
        strmsg = strmsg &  vbTAB & objfile.encrypted
        strmsg = strmsg &  vbTAB & objfile.compressed
        strmsg = strmsg &  vbTAB & mid(objfile.CreationDate,5,2) & "/" &_
                mid(objfile.CreationDate,7,2) & "/" & mid(objfile.CreationDate,1,4)
        strmsg = strmsg & vbTAB & mid(objfile.InstallDate,5,2) & "/" &_
                mid(objfile.InstallDate,7,2) & "/" & mid(objfile.InstallDate,1,4)
        strmsg = strmsg & vbTAB & mid(objfile.LastAccessed,5,2) & "/" &_
                mid(objfile.LastAccessed,7,2) & "/" & mid(objfile.LastAccessed,1,4)
        strmsg = strmsg & vbTAB & mid(objfile.LastModified,5,2) & "/" &_
                mid(objfile.LastModified,7,2) & "/" & mid(objfile.LastModified,1,4)
        objOutputFile.WriteLine ( strmsg)
    End If
Next
 
objOutputFile.Close
Set objFileSystem = Nothing
 
msgbox "done"

Open in new window

0
Jim P.
Asked:
Jim P.
  • 2
1 Solution
 
Dave BrettCommented:
Attached is recursive code below

change
strFolderName = "C:\excelfiles"
to your path

Pls note that I have turned off the test for file extensions, currently all files are returned
 'If (objFile.Extension = "dll" or  objFile.Extension = "exe")   Then

Cheers

Dave
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
strOutputFile = "./" & Split(WScript.ScriptName, ".")(0) & "_" & Hour(Now) & "_" & Minute(Now) & ".txt"
Set objFileSystem = CreateObject("Scripting.fileSystemObject")
Set objOutputFile = objFileSystem.CreateTextFile(strOutputFile, True)
 
strFolderName = "C:\excelfiles"
Set colSubfolders = objWMIService.ExecQuery _
                    ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
                   & "Where AssocClass = Win32_Subdirectory " _
                   & "ResultRole = PartComponent")
 
strmsg = "File_Name" & vbTab & "File_Type" & vbTab & "File_Size" & vbTab & "File_Version" & vbTab & _
         "Manufacturer" & vbTab & "Readable_Attr" & vbTab & "Writeable_Attr" & vbTab & "Hidden_Attr" & vbTab & _
         "System_Attr" & vbTab & "Archive_Attr" & vbTab & "Encrypted_Attr" & vbTab & "Compressed_Attr" & vbTab & _
         "Created_Date" & vbTab & "Installed_Date" & vbTab & "Last_Accessed" & vbTab & "Last_Modified"
 
objOutputFile.WriteLine (strmsg)
strmsg = ""
 
arrFolderPath = Split(strFolderName, "\")
strNewPath = ""
For i = 1 To UBound(arrFolderPath)
    strNewPath = strNewPath & "\\" & arrFolderPath(i)
Next
strPath = strNewPath & "\\"
 
Set colFiles = objWMIService.ExecQuery _
               ("Select * from CIM_DataFile where Path = '" & strPath & "'")
 
For Each objfile In colFiles
    'If (objFile.Extension = "dll" or  objFile.Extension = "exe")   Then
    strmsg = ""
    strmsg = strmsg & objfile.Name
    strmsg = strmsg & vbTab & objfile.FileType
    strmsg = strmsg & vbTab & objfile.filesize
    strmsg = strmsg & vbTab & objfile.Version
    strmsg = strmsg & vbTab & objfile.manufacturer
    strmsg = strmsg & vbTab & objfile.readable
    strmsg = strmsg & vbTab & objfile.writeable
    strmsg = strmsg & vbTab & objfile.Hidden
    strmsg = strmsg & vbTab & objfile.system
    strmsg = strmsg & vbTab & objfile.archive
    strmsg = strmsg & vbTab & objfile.encrypted
    strmsg = strmsg & vbTab & objfile.compressed
    strmsg = strmsg & vbTab & Mid(objfile.CreationDate, 5, 2) & "/" & _
    Mid(objfile.CreationDate, 7, 2) & "/" & Mid(objfile.CreationDate, 1, 4)
    strmsg = strmsg & vbTab & Mid(objfile.InstallDate, 5, 2) & "/" & _
    Mid(objfile.InstallDate, 7, 2) & "/" & Mid(objfile.InstallDate, 1, 4)
    strmsg = strmsg & vbTab & Mid(objfile.LastAccessed, 5, 2) & "/" & _
    Mid(objfile.LastAccessed, 7, 2) & "/" & Mid(objfile.LastAccessed, 1, 4)
    strmsg = strmsg & vbTab & Mid(objfile.LastModified, 5, 2) & "/" & _
    Mid(objfile.LastModified, 7, 2) & "/" & Mid(objfile.LastModified, 1, 4)
    objOutputFile.WriteLine (strmsg)
    ' End If
Next
 
 
 
For Each objFolder In colSubfolders
    GetSubFolders strFolderName
Next
 
objOutputFile.Close
Set objFileSystem = Nothing
MsgBox "done"
 
Sub GetSubFolders(strFolderName)
    Set colSubfolders2 = objWMIService.ExecQuery _
                         ("Associators of {Win32_Directory.Name='" & strFolderName & "'} " _
                        & "Where AssocClass = Win32_Subdirectory " _
                        & "ResultRole = PartComponent")
 
    For Each objFolder2 In colSubfolders2
        strFolderName = objFolder2.Name
        arrFolderPath = Split(strFolderName, "\")
        strNewPath = ""
        For i = 1 To UBound(arrFolderPath)
            strNewPath = strNewPath & "\\" & arrFolderPath(i)
        Next
        strPath = strNewPath & "\\"
 
        Set colFiles = objWMIService.ExecQuery _
                       ("Select * from CIM_DataFile where Path = '" & strPath & "'")
 
        For Each objfile In colFiles
            'If (objFile.Extension = "dll" or  objFile.Extension = "exe")   Then
            strmsg = ""
            strmsg = strmsg & objfile.Name
            strmsg = strmsg & vbTab & objfile.FileType
            strmsg = strmsg & vbTab & objfile.filesize
            strmsg = strmsg & vbTab & objfile.Version
            strmsg = strmsg & vbTab & objfile.manufacturer
            strmsg = strmsg & vbTab & objfile.readable
            strmsg = strmsg & vbTab & objfile.writeable
            strmsg = strmsg & vbTab & objfile.Hidden
            strmsg = strmsg & vbTab & objfile.system
            strmsg = strmsg & vbTab & objfile.archive
            strmsg = strmsg & vbTab & objfile.encrypted
            strmsg = strmsg & vbTab & objfile.compressed
            strmsg = strmsg & vbTab & Mid(objfile.CreationDate, 5, 2) & "/" & _
            Mid(objfile.CreationDate, 7, 2) & "/" & Mid(objfile.CreationDate, 1, 4)
            strmsg = strmsg & vbTab & Mid(objfile.InstallDate, 5, 2) & "/" & _
            Mid(objfile.InstallDate, 7, 2) & "/" & Mid(objfile.InstallDate, 1, 4)
            strmsg = strmsg & vbTab & Mid(objfile.LastAccessed, 5, 2) & "/" & _
            Mid(objfile.LastAccessed, 7, 2) & "/" & Mid(objfile.LastAccessed, 1, 4)
            strmsg = strmsg & vbTab & Mid(objfile.LastModified, 5, 2) & "/" & _
            Mid(objfile.LastModified, 7, 2) & "/" & Mid(objfile.LastModified, 1, 4)
            objOutputFile.WriteLine (strmsg)
            ' End If
        Next
        GetSubFolders strFolderName
    Next
End Sub

Open in new window

0
 
Jim P.Author Commented:
That works great. Thanks!
0
 
Dave BrettCommented:
Thanks for the grade :)
0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now