List all folders and sub folders except those that begin with... Assistance requested

[aarcher]

Here is the code i found and adapted to my needs and works great. But I want to add an exception, to skip folders starting with ???? and move on to the next folder. Any assistance would be appreciated. So i want: For Each myfile, except.

Sub ListMyFiles(MySourcePath, includesubfolders)
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set mysource = MyObject.GetFolder(MySourcePath)
On Error Resume Next
For Each myfile In mysource.Files
icol = 1
Cells(IRow, icol).Value = myfile.Name
icol = icol + 1
Cells(IRow, icol).Value = myfile.Path
icol = icol + 1
Cells(IRow, icol).Value = myfile.DateCreated
icol = icol + 1
Cells(IRow, icol).Value = myfile.datelastmodified
icol = icol + 1
Cells(IRow, icol).Value = myfile.Size
'icol = icol + 1



IRow = IRow + 1
Next
End Sub


Thanks for any assistance,

Al

 

[aarcher]

Ok, this is going to sound like i am really a novice, but i pasted the above code into a module and no macro shows up to run. What am I not seeing.

 

[aarcher]

Ok well I am only 1 step above a novice, LOL!!!

 

[rlv01]

Ok, this is going to sound like i am really a novice, but i pasted the above code into a module and no macro shows up to run. What am I not seeing.

Any subroutine that you pass parameters to (in this case, MySourcepath) will not show up on the Alt-F8 list because it is intended to be called from other code. I have to say that I'm a bit puzzled that you would ask this because your earlier example was the same way and you said it worked for you, which implied that you have other code calling the ListMyFiles Sub.

Here is the code i found and adapted to my needs and works great...

Sub ListMyFiles(MySourcePath, includesubfolders)
    Set MyObject = CreateObject("Scripting.FileSystemObject")
    Set mysource = MyObject.GetFolder(MySourcePath)
    On Error Resume Next
    For Each myfile In mysource.Files
        icol = 1
        Cells(IRow, icol).Value = myfile.Name
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Path
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.DateCreated
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.datelastmodified
        icol = icol + 1
        Cells(IRow, icol).Value = myfile.Size
        'icol = icol + 1
  
        IRow = IRow + 1
    Next
End Sub

That one has parameters and would not have shown up either.

 

[aarcher]

This is what i used to call the other one. i can write simple macors but these are a bit over my head. Thanks for you assistance.

Sub ListFilesByDrive()
iRow = 2 'where you want your first row of data
Call ListMyFiles(Range("H1"), False) 'Where H1 is your filepath (eg, C:\)
End Sub

 

[rlv01]

It would be the same, except that the second parameter, False, is no longer needed

Sub ListFilesByDrive()
    iRow = 2                                         'where you want your first row of data
    Call ListMyFiles(Range("H1"))  'Where H1 is your filepath (eg, C:\)
End Sub

 

[aarcher]

It ran great but did not exclude the folders. Since i am not at work i changed the excluded folders to 2 on my c:\al\ drive. c:\al\gre and c:\al\mac. i changed the-- Select Case UCase(Left(MyFile.Path, 7)) to-- Select Case UCase(Left(MyFile.Path, 9))

Here is the full set. Sorry i dont know how to put the code in a separate box.



Sub ListFilesByDrive()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
iRow = 2 'where you want your first row of data
Call ListMyFiles(Range("H1")) 'Where H1 is your filepath (eg, C:\)
End Sub


Sub ListMyFiles(MySourcePath)
Dim MyObject As Object, MySource As Object, MySubFolder As Object, MyFile As Object
Dim iRow As Long, iCol As Long
'
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set MySource = MyObject.GetFolder(MySourcePath)
'On Error Resume Next


iRow = 2
iCol = 1
ListFiles MyObject, MySource, iRow, iCol 'Top level
End Sub


Private Sub ListFiles(ByRef MyObject, ByRef MySource, ByRef iRow As Long, ByRef iCol As Long)
Dim MySubFolder As Object, MyFile As Object


On Error Resume Next
For Each MySubFolder In MySource.subFolders
ListFiles MyObject, MySubFolder, iRow, iCol 'recursively look in subdirectories
Next MySubFolder


For Each MyFile In MySource.Files
'Except files in folders starting with "R:\zzzz" or "R:\aaaa"
Select Case UCase(Left(MyFile.Path, 9))
Case "c:\al\gre*", "c:\al\mac*"
Case Else
iCol = 1
Cells(iRow, iCol).Value = MyFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.DateCreated
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.datelastmodified
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.Size
'icol = icol + 1
iRow = iRow + 1
End Select
Next MyFile
End Sub

 

[rlv01]

Select Case UCase(Left(MyFile.Path, 9))
Case "c:\al\gre*", "c:\al\mac*"

That's not going to work. Case will not interpret the "*" char as a wildcard.

Btw, Here is how to use code tags

1. Paste your VBA code into the text area
2. Highlight (select) the code
3. Cick the "#" button.

This will wrap your texts in code tags which will display it more clearly

 

[aarcher]

Ok, took out the "*" and it still included the folders, c:\al\greene and c:\al\macdds. Wow, though it runs like a charm.

Any other suggestions?

Al

 

[rlv01]

Ok, took out the "*" and it still included the folders, c:\al\greene and c:\al\macdds. Wow, though it runs like a charm.

Any other suggestions?

Al

The exclusion is based on string matching, so if you want it to exclude c:\al\greene and c:\al\macdds then use those strings:

Select Case UCase(Left(MyFile.Path, 12))
Case "C:\AL\GREENE","C:\AL\MACDDS"

Notice that your folder names have deliberately been converted to upper case for the comparison.

 

[aarcher]

That worked!! I am then thinking that if i want to exclude 2 folders with different length text i would add another line, like:

        Select Case UCase(Left(MyFile.Path, 12))
        Case "C:\AL\GREENE"
        Select Case UCase(Left(MyFile.Path, 11))
        Case "C:\AL\MACDD"

Also, in know UCase and LCase what is mixed case, so you could pick up a folder with mixed letters.

thanks for all you assistance, i truly appreciate it.

Al