Solved

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

Posted on 2013-01-15
12
603 Views
Last Modified: 2013-01-17
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
Comment
Question by:awilderbeast
  • 8
  • 4
12 Comments
 
LVL 5

Expert Comment

by:LazyFolk
ID: 38778828
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
 
LVL 1

Author Comment

by:awilderbeast
ID: 38778875
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
 
LVL 1

Author Comment

by:awilderbeast
ID: 38783576
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
 
LVL 1

Author Comment

by:awilderbeast
ID: 38778947
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
 
LVL 5

Expert Comment

by:LazyFolk
ID: 38781707
add a boolean in the parameters of GetFile function

GetFiles (path,boolean)

Depending on boolean value, you display message box or not
0
 
LVL 1

Author Comment

by:awilderbeast
ID: 38782416
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 5

Accepted Solution

by:
LazyFolk earned 500 total points
ID: 38782991
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
 
LVL 1

Author Comment

by:awilderbeast
ID: 38783081
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
 
LVL 5

Expert Comment

by:LazyFolk
ID: 38783153
yes this should work
0
 
LVL 1

Author Closing Comment

by:awilderbeast
ID: 38783577
Thanks!
0
 
LVL 1

Author Comment

by:awilderbeast
ID: 38786900
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
 
LVL 1

Author Comment

by:awilderbeast
ID: 38786945
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

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Does the idea of dealing with bits scare or confuse you? Does it seem like a waste of time in an age where we all have terabytes of storage? If so, you're missing out on one of the core tools in every professional programmer's toolbox. Learn how to …
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

863 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

24 Experts available now in Live!

Get 1:1 Help Now