Solved

vbscript FileSystemObject skipping over files with special characters

Posted on 2011-02-28
18
718 Views
Last Modified: 2012-05-11
The code attached is susposed to only delete empty directories created over x days old.

The code works ok if none of the files in a folder have special characters in their names (like ' or " or , ), but if a folder has file(s) with special characters it does not get counted in SubFolder.Files.Count
so the code winds up deleteing the folder even though there are files in the folder.

thank you in advance
Dim iNumberofFiles
Dim LastModDate
Dim Days, Path

Set objFSO = CreateObject( "Scripting.FileSystemObject" )
path       = "\\our-file\documents$\Quotes"
Days = 90


Set OrderPath = objFSO.GetFolder(path)

For Each Folder In OrderPath.subfolders

    iNumberofFiles = 0
    LastModDate = Folder.DateLastModified

    Set SubFolderPath = objFSO.GetFolder(Folder)

    For Each SubFolder In SubFolderPath.subfolders    
        iNumberOfFiles = iNumberOfFiles + SubFolder.Files.Count
        If SubFolder.DateLastModified < LastModDate Then
           LastModDate = SubFolder.DateLastModified
        End If
    Next

    If DateDiff( "d", LastModDate, Date ) > Days and iNumberofFiles = 0 Then
       Folder.Delete True 
    End If
Next

Open in new window

0
Comment
Question by:BFanguy
  • 12
  • 6
18 Comments
 
LVL 13

Expert Comment

by:connectex
Comment Utility
Ok. I can provide you some code. But first you know your code is only going to down two levels. Are you trying to delete all empty folders under the path?
0
 

Author Comment

by:BFanguy
Comment Utility
Yes, actually I do only want it to look 2 levels deep.

I think the problem is not with the special characters, but the subfolder.count is reporting 0 files unless there is a another subfolder under the folder?

maybe I am getting my count from the wrong folder?
0
 

Author Comment

by:BFanguy
Comment Utility
the reason for only looking two levels deep is this:

our erp creates a folder for each order that is created under a folder called Orders, using the order number and then it creates 5 sub folders under that folder.  Users can then add files as needed (and subfolders) to the folders.  If no files have been added to any of the folders and the folder was created over 90 days ago, i want to remove the blank folder.

Ex:
CC120005
    Customer_Correspondence
    Drawings
    Pictures
    Accounting
    DataBooks

Really, I would just settle for checking 1 level and if there are no files and the last modified date is over 90 days old, drop the directory (and sub directories)

in the case above, if there are no files under CC120005 and it has not been modifed over 90 days, delete it.
   
0
 

Author Comment

by:BFanguy
Comment Utility
Maybe a better way to explain:  I would like to drop the main folder CC120005 if there are no files under any of its subfolders and their subfolders.

looks like if I add a Count on one of the folders, it does not include files within it's subfolders.
0
 
LVL 13

Expert Comment

by:connectex
Comment Utility
Also you code appears to be using the last modied date on the first level folder for comparision. Are you sure you don't want to use the current date for this comparision?
0
 

Author Comment

by:BFanguy
Comment Utility
I want to use the latest modified date for any of the folders within an Order (ex: CC120005).

so if any of the sub folders have a newer modified date than the folder for CC120005, then i want to use it to compare against today.

so as you are looping through all of the subfolders and their sub folders, get the latest modifed date and then when finished test it against Now and if it's >90 and their are no files, delete the folder CC120005
0
 

Author Comment

by:BFanguy
Comment Utility
I'm close (not very good at VB), but when I hit a folder with a sub folder, it dies in the function at line 32, char 6  Object doesn't support this property or method: 'Folder'
Dim iNumberofFiles
Dim LastModDate
Dim Days, Path

Set objFSO = CreateObject( "Scripting.FileSystemObject" )
path       = "\\file\visualdocuments$\Orders"
Days = 90
Set ofs = CreateObject("Scripting.FileSystemObject")

Set OrderPath = objFSO.GetFolder(path)

For Each Folder In OrderPath.subfolders
    LastModDate = Folder.DateLastModified
    iNumberofFiles = GetCount(path & "\" & Folder.Name, ofs)
    msgbox("Folder: " & Folder.Name & " Age: " & DateDiff( "d", LastModDate, Date ) & "  number of Files: " & iNumberofFiles)
    If DateDiff( "d", LastModDate, Date ) > Days and iNumberofFiles = 0 Then
       msgbox ("delete folder: " & Folder.Name)
'       Folder.Delete True 
    End If
Next

Function getCount(sPath, ofs) 
  n = 0 
  With ofs.GetFolder(sPath)
  n = n + .files.count 
  if .SubFolders.Count > 0 Then 
     for each folder in .SubFolders 
     n= n + getCount(sPath & "\" & .folder.Name, ofs) 
     next 
  End if 
  End With
  getCount = n 
End Function

Open in new window

0
 

Author Comment

by:BFanguy
Comment Utility
should I be concantenating sPath in the function with .Name?
0
 
LVL 13

Expert Comment

by:connectex
Comment Utility
I'm working on some code. It's more generic but it should do as you ask. It's a subset of a more powerful script I already wrote. I'm going to strip it down. But I have to take care of my kids for the next few hours.
0
Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

 

Author Comment

by:BFanguy
Comment Utility
ok, thanks!!!
0
 

Author Comment

by:BFanguy
Comment Utility
ignore "should I be concantenating sPath in the function with .Name? "  i already am.
0
 
LVL 13

Accepted Solution

by:
connectex earned 500 total points
Comment Utility
Here's the code I came up with. You need to change lines under Set variables section to your liking:

' Set variables
sstrPath = "\our-file\documents$\Quotes"
intNumOfDays = 90
sintMaxLevels = 2
sblnTest = True
sblnDebug = False

All global variables strart with 's'. sstrPath is the full path to check. intNumOfDays is the number of days old the folder must be based on modified date to be considered for deletion. sintMaxLevels is the number of levels downward to check. sblnTest is a test mode which will show the results without actually deleting the folders (great for testing the code). sblnDebug may assist you with understanding the this code, should you desire. You've given me the impression your not very well versed in programming techniques. The CheckSubFolders function is recursive. Recursion is the best way to navigate the file system or other inverted tree type structures. But while it's efficent, it also confuses most people who haven't used it before. So you may want to search "programming recursion" for some better and easier to understand examples before trying to deciper this code. Let me know if you have any problems or questions.

Option Explicit
' Dim variables
Dim sobjFSO, sstrPath, sdteCutoff, sintMaxLevels, sintFldrDelCnt, sblnTest, sstrTest, sblnDebug
Dim intTemp, intNumOfDays

' Set variables
sstrPath = "\our-file\documents$\Quotes"
intNumOfDays = 90
sintMaxLevels = 2
sblnTest = True
sblnDebug = False
sintFldrDelCnt = 0
If sblnTest Then sstrTest = "TEST MODE - "
sdteCutoff = DateAdd("d", -intNumofDays, Now())
	
' Read through directory list, delete file if older then cutoff date, and report results
Set sobjFSO = CreateObject("Scripting.FileSystemObject")
WScript.Echo "Removing empty folders before " & sdteCutoff & vblf
intTemp = CheckSubFolders(sstrPath, 0)
WScript.Echo vblf & sstrTest & "Total of " & sintFldrDelCnt & " folders deleted." & vblf
WScript.Quit 0

' Compares folder date with cutoff date
Function CheckFolder(objFolder)
  Dim intFolderDate
	
  CheckFolder = False
  intFolderDate = objFolder.DateLastModified
  If intFolderDate < sdteCutoff Then
    CheckFolder = True
  End If
End Function

' Enumerates subfolders, deletes folder if if meet the requirements
Function CheckSubFolders(strPath, intLevel)
  Dim objFolder, objSubFolder, intFldrDelCnt, intPrevFldrDelCnt

  intFldrDelCnt = 0
  If sblnDebug Then WScript.Echo "Folder: " & strPath
  On Error Resume Next
  Set objFolder = sobjFSO.GetFolder(strPath)
  If Err Then
    WScript.Echo "ERROR - Starting folder does not exist."
    WScript.Quit 1
  End If
  On Error GoTo 0
  If sintMaxLevels > 0 Then
    On Error Resume Next
    For Each objSubFolder In objFolder.SubFolders
      If intLevel < sintMaxLevels Then
        intPrevFldrDelCnt = CheckSubFolders(objSubFolder.Path, intLevel+1)
      End If
      If Err Then WScript.Echo "ERROR - " & Err.Description & ": " & objSubFolder.Path
    Next
    On Error GoTo 0
  End If
  If sblnDebug Then
    WScript.Echo "SubFolders: " & objFolder.SubFolders.Count-intFldrDelCnt & "  Files: " & objFolder.Files.Count & "  CutOff Date: " & CheckFolder(objFolder)
  End if
  If objFolder.SubFolders.Count-intPrevFldrDelCnt = 0 And objFolder.Files.Count = 0 And CheckFolder(objFolder) Then
    WScript.Echo sstrTest & "Deleting folder: " & objFolder.Path
    If sblnTest Then intFldrDelCnt = intFldrDelCnt + 1
    sintFldrDelCnt = sintFldrDelCnt+1
    If Not sblnTest Then
      On Error Resume Next
      objFolder.Delete
      If Err Then
        WScript.Echo sstrTest & "ERROR - " & Err.Description & ": " & objFile.Name
      End If
      On Error GoTo 0
    End If
  End If
  CheckSubFolders = intFldrDelCnt
  If sblnDebug Then WScript.Echo strPath & " - CheckSubFolders: " & CheckSubFolders
End Function

Open in new window

0
 

Author Closing Comment

by:BFanguy
Comment Utility
Works Great!!

thanks
0
 
LVL 13

Expert Comment

by:connectex
Comment Utility
Glad I could help.
0
 

Author Comment

by:BFanguy
Comment Utility
Connectex, I may have spoke too soon.

your code is deleting the empty subfolders but it is not deleting the order folder.
example:  for the following folder / subfolders:
CC120005
    Customer_Correspondence
    Drawings
    Pictures
    Accounting
    DataBooks
it deletes all of the subfolders, but leaves the folder CC120005


0
 

Author Comment

by:BFanguy
Comment Utility
and of course it won't delete the empty folder for another 90 days due to the modifed date (from deleteing the subfolders)
0
 
LVL 13

Expert Comment

by:connectex
Comment Utility
Sorry, I've was quite busy lately and a bit on the sick side too. But I've modified the code slightly. I was checking on the folders after other operations, i.e. deletes, may have occured. Now it's grabbing the modified date before any deletes are done. Therefore if the subfolders are deleted they will not impact the date logic.

 
Option Explicit
' Dim variables
Dim sobjFSO, sstrPath, sdteCutoff, sintMaxLevels, sintFldrDelCnt, sblnTest, sstrTest, sblnDebug
Dim intTemp, intNumOfDays

' Set variables
sstrPath = "\our-file\documents$\Quotes"
intNumOfDays = 90
sintMaxLevels = 2
sblnTest = False
sblnDebug = False
sintFldrDelCnt = 0
If sblnTest Then sstrTest = "TEST MODE - "
sdteCutoff = DateAdd("d", -intNumofDays, Now())
	
' Read through directory list, delete file if older then cutoff date, and report results
Set sobjFSO = CreateObject("Scripting.FileSystemObject")
WScript.Echo "Removing empty folders before " & sdteCutoff & vblf
intTemp = CheckSubFolders(sstrPath, 0)
WScript.Echo vblf & sstrTest & "Total of " & sintFldrDelCnt & " folders deleted." & vblf
WScript.Quit 0

' Compares folder date with cutoff date
Function CheckFolder(intFolderDate)
  CheckFolder = False
  If intFolderDate < sdteCutoff Then
    CheckFolder = True
  End If
End Function

' Enumerates subfolders, deletes folder if if meet the requirements
Function CheckSubFolders(strPath, intLevel)
  Dim objFolder, objSubFolder, intFldrDelCnt, intPrevFldrDelCnt, intFolderDate	

  intFldrDelCnt = 0
  If sblnDebug Then WScript.Echo "Folder: " & strPath
  On Error Resume Next
  Set objFolder = sobjFSO.GetFolder(strPath)
  If Err Then
    WScript.Echo "ERROR - Starting folder does not exist."
    WScript.Quit 1
  End If
  On Error GoTo 0
  If sintMaxLevels > 0 Then
  	intFolderDate = objFolder.DateLastModified
    On Error Resume Next
    For Each objSubFolder In objFolder.SubFolders
      If intLevel < sintMaxLevels Then
        intPrevFldrDelCnt = CheckSubFolders(objSubFolder.Path, intLevel+1)
      End If
      If Err Then WScript.Echo "ERROR - " & Err.Description & ": " & objSubFolder.Path
    Next
    On Error GoTo 0
  End If
  If sblnDebug Then
    WScript.Echo "SubFolders: " & objFolder.SubFolders.Count-intFldrDelCnt & "  Files: " & objFolder.Files.Count & "  CutOff Date: " & CheckFolder(intFolderDate)
  End if
  If objFolder.SubFolders.Count-intPrevFldrDelCnt = 0 And objFolder.Files.Count = 0 And CheckFolder(intFolderDate) Then
    WScript.Echo sstrTest & "Deleting folder: " & objFolder.Path
    If sblnTest Then intFldrDelCnt = intFldrDelCnt + 1
    sintFldrDelCnt = sintFldrDelCnt+1
    If Not sblnTest Then
      On Error Resume Next
      objFolder.Delete
      If Err Then
        WScript.Echo sstrTest & "ERROR - " & Err.Description & ": " & objFile.Name
      End If
      On Error GoTo 0
    End If
  End If
  CheckSubFolders = intFldrDelCnt
  If sblnDebug Then WScript.Echo strPath & " - CheckSubFolders: " & CheckSubFolders
End Function

Open in new window

0
 

Author Comment

by:BFanguy
Comment Utility
connectex, thank you, I am running the script (on 30000 folders) and it looks like its working fine.

thank you very much for your assistance.
0

Featured Post

Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

Join & Write a Comment

Recently, I had the need to build a standalone system to run a point-of-sale system. I’m running this on a low-voltage Atom processor, so I wanted a light-weight operating system, but still needed Windows. I chose to use Microsoft Windows Server 200…
A quick step-by-step overview of installing and configuring Carbonite Server Backup.
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

772 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now