CODEWITHSUNDEEP
vbscriptfilesystemobject
user3284471
user3284471

Reputation: 1

Using File System object to make a log of files with a name that matches a string

I have a directory that contains many files with the same name nested in different folders and subfolders. I'm trying to make a vbs script that will search through the directory and find any of files called "history" and write the name, path and date modified to a files.

I have successfully been able to make a script to return all the files in the folder, but haven't been able to make it so only the ones called "History" get written. I was trying to add a If statement within the for so it would be like:

For Each ObjFolder In ObjSubFolders
    If ObjFolder.Name = "history*.*" Then
    ResultLogFile.WriteLine(ObjFolder.Name & vbab & ObjFolder.Path)
End If

But that was not working

This is what I have so far:

Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0

Dim fso
Dim OutputFileName
Dim ResultLogFile


vCurrentDate = Now
'Year string
vCurrentYear = CStr(DatePart("yyyy",vCurrentDate))

'Month string
If DatePart("m",vCurrentDate) < 10 Then
    vCurrentMonth = "0" & CStr(DatePart("m",vCurrentDate))
Else
    vCurrentMonth = CStr(DatePart("m",vCurrentDate))
End If

'Day string
If DatePart("d",vCurrentDate) < 10 Then
    vCurrentDay = "0" & CStr(DatePart("d",vCurrentDate))
Else
    vCurrentDay = CStr(DatePart("d",vCurrentDate))
End If  

Set fso = CreateObject("Scripting.FileSystemObject")

OutputFileName = "C:\historylogs\" & vCurrentYear & "-" & vCurrentMonth & "-" & vCurrentDay & ".tsv"

'MySourcePath = "C:\Test Folder\"
'Check if file already exists:

If fso.FileExists(OutputFileName) Then
    'File exists, so open it for appending and add no new header info:
    Set ResultLogFile = fso.OpenTextFile(OutputFileName, ForAppending, True, TristateTrue)
Else
    'File did not exist, so create it and add a header
    Set ResultLogFile = fso.OpenTextFile(OutputFileName, ForWriting, True, TristateTrue)
    'Create log headers
    ResultLogFile.WriteLine "FileName" & vbTab & "FilePath" & vbTab & "DateLastModified"
End If

GetFiles("C:\Test Folder")

Function GetFiles(FolderName)
    'On Error Resume Next

Dim ObjFolder
Dim ObjSubFolders
Dim ObjSubFolder
Dim ObjFiles
Dim ObjFile 

Set ObjFolder = fso.GetFolder(FolderName)
Set ObjFiles = ObjFolder.Files

'Write all files to output files
For Each ObjFile In ObjFiles
    ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
Next
'Getting all subfolders
Set ObjSubFolders = ObjFolder.SubFolders

For Each ObjFolder In ObjSubFolders
    'Writing SubFolder Name and Path
    ResultLogFile.WriteLine(ObjFolder.Name & vbab & ObjFolder.Path)

    'Getting all Files from subfolder
    GetFiles(ObjFolder.Path)
Next

End Function

Upvotes: 0

Views: 1370

Answers (1)

JustSomeQuickGuy
JustSomeQuickGuy

Reputation: 943

You could do it a few ways.. change this if..

For Each ObjFile In ObjFiles
  ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
Next

..you want to find any file with history in the name, regardless where:

For Each ObjFile In ObjFiles
  If InStr(1, ObjFile.Name, "history") Then
    ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
  End If
Next

..you want to find all files that start with history:

For Each ObjFile In ObjFiles
  If LCase(Mid(ObjFile.Name, 1, 7)) = "history" Then
    ResultLogFile.WriteLine(ObjFile.Name & vbTab & ObjFile.Path & vbTab & ObjFile.DateLastModified)
  End If
Next

EDIT: Responding to your comment, you could have a recursive sub like this. It will search all folders and subfolders, for any file that starts with whatever you pass.. so if you pass "history" and file history* will be found.

Set objFSO = CreateObject("Scripting.FileSystemObject")

Call findFiles(objFSO.GetFolder("C:\temp"), "history")

Sub findFiles(objFolder, strMatchString)

  For Each objSubFolder In objFolder.SubFolders
    Call findFiles (objSubFolder, strMatchString)
  Next

  Set objFiles = objFolder.Files

  For Each objFile In objFiles
    If LCase(Mid(objFile.Name, 1, Len(strMatchString))) = LCase(strMatchString) Then
      MsgBox objFile.Name & vbTab & objFile.Path & vbTab & objFile.DateLastModified
    End If
  Next 
End Sub

Upvotes: 1

Related Questions