Improve company productivity with a Business Account.Sign Up

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

Part complete vbs for each file in folder and files in subfolders...

Hi all,

just need some help with the below, at the mo i have to for eaches but im guessing there is an easier way.

i want to get all files in the folder selected and all files in all subfolders...

Thanks for any help

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select The Folder To Enumerate :", (0))
If objFolder Is Nothing Then
Wscript.Quit
Else
	Set objFolderItem = objFolder.Self
	objPath = objFolderItem.Path
End If
 
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(objPath)
For each objFolder.SubFolders in objFolder

Next

For each objFile in objFolder.Files
	if objFile.DateLastModified < Date()-8 Then
	msgBox "Found file: " & objFile.Name
	End If
Next

Open in new window

0
awilderbeast
Asked:
awilderbeast
  • 8
  • 4
1 Solution
 
LazyFolkCommented:
Dir() function may help you (depend what you try to acheive)

http://bytes.com/topic/visual-basic/answers/637239-using-dir-list-folder-names

MSDN has an example on how to detect directory if you want to do this recursively
http://msdn.microsoft.com/en-us/library/dk008ty4(v=vs.71).aspx
0
 
awilderbeastAuthor Commented:
i got it sussed! thanks

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select The Folder To Search :", (0))
If objFolder Is Nothing Then
Wscript.Quit
Else
	Set objFolderItem = objFolder.Self
	objPath = objFolderItem.Path
End If
 
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(objPath)

GetFiles(objFolder)

Function GetFiles(FolderName)
    On Error Resume Next
    Dim ObjSubFolders
    Dim ObjSubFolder
    Dim ObjFiles
    Dim ObjFile
 
    Set ObjFiles = objFolder.Files
     
    For Each ObjFile In ObjFiles
		if objFile.DateLastModified < Date()-8 Then
		msgBox "Found file: " & objFile.Name
		End If
    Next
     
    Set ObjSubFolders = ObjFolder.SubFolders     
    For Each ObjFolder In ObjSubFolders         
        GetFiles(ObjFolder.Path)
    Next
End Function

Open in new window

0
 
awilderbeastAuthor Commented:
I've requested that this question be closed as follows:

Accepted answer: 0 points for awilderbeast's comment #a38778875

for the following reason:

Found answer
0
What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

 
awilderbeastAuthor Commented:
one addition: i need it to msgbox only once but its msgboxing 3 times (as i have 3 subfolders in what im testing)

what can i do for it to only msgbox 1 count?

thanks

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select The Folder To Search :", (0))
If objFolder Is Nothing Then
Wscript.Quit
Else
	Set objFolderItem = objFolder.Self
	objPath = objFolderItem.Path
End If
 
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(objPath)
Dim CountFiles
CountFiles = 0

GetFiles(objFolder)

Function GetFiles(FolderName)
    On Error Resume Next
    Dim ObjSubFolders
    Dim ObjSubFolder
    Dim ObjFiles
    Dim ObjFile
 
    Set ObjFiles = objFolder.Files
    
    For Each ObjFile In ObjFiles
		if objFile.DateLastModified < Date()-8 Then
		'msgBox "Found file: " & objFile.Name
		CountFiles = CountFiles + 1
		End If
    Next
     
    Set ObjSubFolders = ObjFolder.SubFolders     
    For Each ObjFolder In ObjSubFolders         
        GetFiles(ObjFolder.Path)
    Next
	msgBox CountFiles
	
End Function

Open in new window

0
 
LazyFolkCommented:
add a boolean in the parameters of GetFile function

GetFiles (path,boolean)

Depending on boolean value, you display message box or not
0
 
awilderbeastAuthor Commented:
i tried the below, i get.. cannot use a parentheses when calling a sub line 15 char 25

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder (0, "Select The Folder To Search :", (0))
If objFolder Is Nothing Then
Wscript.Quit
Else
	Set objFolderItem = objFolder.Self
	objPath = objFolderItem.Path
End If
 
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder(objPath)
Dim CountFiles
CountFiles = 0

GetFiles(objFolder,true)

Function GetFiles(FolderName,displaybox)
    On Error Resume Next
    Dim ObjSubFolders
    Dim ObjSubFolder
    Dim ObjFiles
    Dim ObjFile
 
    Set ObjFiles = objFolder.Files
    
    For Each ObjFile In ObjFiles
		if displaybox = true Then
			if objFile.DateLastModified < Date()-8 Then
			'msgBox "Found file: " & objFile.Name
			CountFiles = CountFiles + 1
			End If
		End If
    Next
     
    Set ObjSubFolders = ObjFolder.SubFolders     
    For Each ObjFolder In ObjSubFolders         
        GetFiles(ObjFolder.Path,false)
    Next
	msgBox CountFiles
	
End Function

Open in new window

0
 
LazyFolkCommented:
Can you explain what you are trying to achieve ?

From what I see you try to count the number of file in a given folder (including sub folders)

Is that correct ?


The following code achieve this :

Sub Button1_Click()
    Dim fileCount
    fileCount = 0
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Select The Folder To Search :", (0))
    If objFolder Is Nothing Then
        Wscript.Quit
    Else
        Set objFolderItem = objFolder.Self
        objPath = objFolderItem.Path
    End If
 
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(objPath)

    fileCount = CountFiles(objFolder)
    MsgBox (fileCount)
End Sub

Function CountFiles(objFolder)
    On Error Resume Next
    Dim objSubFolder
    Dim objFile
    Dim fileCount
    
    fileCount = 0
    
    ' Count files in this folder
    For Each objFile In objFolder.Files
        If objFile.DateLastModified < Date - 8 Then
            'msgBox "Found file: " & objFile.Name
            fileCount = fileCount + 1
        End If
    Next
    
    ' Count files in subfolders
    For Each objSubFolder In objFolder.SubFolders
        fileCount = fileCount + CountFiles(objSubFolder)
    Next
    CountFiles = fileCount
End Function

Open in new window


The main program is included in the click method of Button1 in the attached excel sheet


The function CountFile return the number of file in a given folder including subfolders.
This fiunction call itself to get the number of files in subfolders.

The total is displayed in a message box at the end of the main program
fileCount.xlsm
0
 
awilderbeastAuthor Commented:
Well I actually need it to delete any file older than 8 days then tell me how many it did, i think youve done it as above, but in place of the

'msgBox "Found file: " & objFile.Name

do i just do a

objFile.Delete

?

Thanks
0
 
LazyFolkCommented:
yes this should work
0
 
awilderbeastAuthor Commented:
Thanks!
0
 
awilderbeastAuthor Commented:
Hey there, just need a little extra adding to this, which when ive tried i get

line 27 Char 1
error: wrong number of arguments of invalid property assignment

im trying to check for any read only files and change them to read write, then delete them if they are older than 8 days

Thanks

Sub Button1_Click()
    Dim fileCount
    fileCount = 0
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "Select The Folder To Search :", (0))
    If objFolder Is Nothing Then
        Wscript.Quit
    Else
        Set objFolderItem = objFolder.Self
        objPath = objFolderItem.Path
    End If
 
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(objPath)

    fileCount = CountFiles(objFolder)
    MsgBox (fileCount)
End Sub

Function CountFiles(objFolder)
    On Error Resume Next
    Dim objSubFolder
    Dim objFile
    Dim fileCount
    
    fileCount = 0
    
    ' Count files in this folder
    For Each objFile In objFolder.Files
        If objFile.Attributes AND ReadOnly Then
		objFile.Attributes = objFile.Attributes XOR ReadOnly
	End If
        If objFile.DateLastModified < Date - 8 Then
            objFile.Delete
            fileCount = fileCount + 1
        End If
    Next
    
    ' Count files in subfolders
    For Each objSubFolder In objFolder.SubFolders
        fileCount = fileCount + CountFiles(objSubFolder)
    Next
    CountFiles = fileCount
End Function

Open in new window

0
 
awilderbeastAuthor Commented:
actually i wouldnt mind making a few addiotns, heres the new question for any help you can provide

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_27998757.html

Thanks!
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

What Kind of Coding Program is Right for You?

There are many ways to learn to code these days. From coding bootcamps like Flatiron School to online courses to totally free beginner resources. The best way to learn to code depends on many factors, but the most important one is you. See what course is best for you.

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