Need help getting all files in all folders 2

[DougP]

I been tasked with finding all documents to Zip them down to save space. Anyway here is my code so far. I would like to save it in a table and create reports later.
Each folder has one or more under it and so on.
So I need to call the same ocde over and over, I guess.

    Dim Conn2 As ADODB.Connection
    Dim Rs1 As ADODB.Recordset
    Dim SQLCode As String
    Set Conn2 = CurrentProject.Connection
    Set Rs1 = New ADODB.Recordset
    SQLCode = "SELECT * FROM [FoldersFound];"
    Rs1.Open SQLCode, Conn2, adOpenStatic, adLockOptimistic
    
    'MyPath = "F:\CLIENT ADMIN TAMPA 2007\"    ' Set the path.
    MyName = Dir(MyPath, vbDirectory)    ' Retrieve the first entry.
    Do While MyName <> ""    ' Start the loop.
        ' Ignore the current directory and the encompassing directory.
        If MyName <> "." And MyName <> ".." Then
            ' Use bitwise comparison to make sure MyName is a directory.
            If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then
                
                Debug.Print MyName    ' Display entry only if it's a directory
                CurrentDir = MyName
                If MyName = "Project Reports" Then
                    GetFileInProjectReports
                End If
            Else
                Rs1.AddNew
                Debug.Print MyName    'this is a file in that folder
                Rs1![Folder Name] = CurrentDir
                Rs1![File Name] = MyName
                Rs1![File Size] = FileLen(MyName)
                Rs1.Update
            End If
        End If
        MyName = Dir    ' Get next entry.
    Loop

All I have is Access to program with, No VB6 and I don't know VB.NET good enough.
TIA

DougP

 

[ck1999]

There is a program called folderinfo that works real well in outputing folder info into an excel spreadsheet.

check out this thread the below code is based off of it and yours

url://

http://www.tek-tips.com/viewthread.cfm?qid=1077512

BASED off of PHV

 Dim Conn2 As ADODB.Connection
    Dim Rs1 As ADODB.Recordset
    Dim SQLCode As String


Sub LoopFoldersListFiles(path As String)
Dim fso As New FileSystemObject
Dim f As Folder, sf As Folder, fi As File
    Set f = fso.GetFolder(path)
    For Each sf In f.SubFolders
         LoopFoldersListFiles(sf.Path)
    Next
    For Each fi In f.Files
        Rs1.AddNew
                Debug.Print MyName    'this is a file in that folder
                Rs1![Folder Name] = sf.path
                Rs1![File Name] = fi
              ' Rs1![File Size] = FileLen(MyName)
                Rs1.Update
    Next
End Sub

sub initialize   'from your code above
 Set Conn2 = CurrentProject.Connection
    Set Rs1 = New ADODB.Recordset
    SQLCode = "SELECT * FROM [FoldersFound];"
    Rs1.Open SQLCode, Conn2, adOpenStatic, adLockOptimistic
    
    MyPath = "F:\CLIENT ADMIN TAMPA 2007\"    ' Set the 
    LoopFoldersListFiles(myPath)


path.

By the way this was not tested

ck1999

 

[Remou]

Have a look here:

http://msdn2.microsoft.com/en-us/library/aa190819(office.10).aspx

Watch out for shortcut files.

 

[DougP]

Just one issue, how do I declare "FileSystemObject"
Error: User defined type not defined
I did not see it anywhere.

DougP

 

[PHV]

Add a reference to Microsoft Scripting Runtime.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DougP]

One other issue
' Rs1![File Size] = FileLen(MyName)
I need the file size which is the whole purpose of do this.

DougP

 

[MikeC14081972]

Add a reference to Microsoft Scripting Runtime

Do this in the IDE under Tools > References

 

[DougP]

Go it
FileLen(fi)


DougP

 

[DougP]

we are so close
getting error on sf.path
It loops through here a few times and sf.path has foldernames and then

For Each sf In f.SubFolders
LoopFoldersListFiles (sf.path)
Next

When it’s done it drops into the following loop but sf.path is not set to anything.

For Each fi In f.Files
Rs1![Folder Name] = sf.path
Rs1![File Name] = fi
Rs1![File Size] = FileLen(fi)
Rs1.Update
Next

all code

Sub LoopFoldersListFiles(path As String)

    ' NOTE: need to add a reference to the Microsoft Scripting runtime
    
    Dim fso As New FileSystemObject
    Dim fso As FileSystemObject
    Dim f As Folder, sf As Folder, fi As File
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    Set f = fso.GetFolder(path)
    For Each sf In f.SubFolders
         LoopFoldersListFiles (sf.path)
    Next
    For Each fi In f.Files
        Rs1.AddNew
      Rs1![Folder Name] = sf.path
      Rs1![File Name] = fi
      Rs1![File Size] = FileLen(fi)
      Rs1.Update
    Next
    
End Sub
[code]

DougP

 

[PHV]

Sub LoopFoldersListFiles(path As String)
    ' NOTE: need to add a reference to the Microsoft Scripting runtime
    Dim fso As FileSystemObject
    Dim f As Folder, sf As Folder, fi As File
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(path)
    For Each sf In f.SubFolders
         LoopFoldersListFiles sf.path
    Next
    For Each fi In f.Files
      Rs1.AddNew
      Rs1![Folder Name] = path
      Rs1![File Name] = fi
      Rs1![File Size] = FileLen(fi)
      Rs1.Update
    Next
End Sub

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DougP]

Thanks Everyone.
here is my final code

Global Conn2 As ADODB.Connection
Global Rs1 As ADODB.Recordset
Global SQLCode As String
Global f As Folder, sf As Folder, fi As File
Global fso As New FileSystemObject
---------

Private Sub cmdBrowseforFiles_Click()

    Set Conn2 = CurrentProject.Connection
    Set Rs1 = New ADODB.Recordset
    SQLCode = "SELECT * FROM [FoldersFound];"
    Rs1.Open SQLCode, Conn2, adOpenStatic, adLockOptimistic
    
    MyPath = "F:\CLIENT ADMIN TAMPA 2007\"    ' Set the path.
    LoopFoldersListFiles (MyPath)

End Sub

Sub LoopFoldersListFiles(path As String)

    ' NOTE: need to add a reference to the Microsoft Scripting runtime
    
    Dim fso As FileSystemObject
    Dim f As Folder, sf As Folder, fi As File
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(path)
    For Each sf In f.SubFolders
         LoopFoldersListFiles sf.path
    Next
    For Each fi In f.Files
      Rs1.AddNew
      Rs1![Folder Name] = path
      Rs1![File Name] = fi
      Rs1![File Size] = FileLen(fi)
      Rs1.Update
    Next
    
End Sub

DougP

 

[PHV]

Get rid of the following lines:
Global f As Folder, sf As Folder, fi As File
Global fso As New FileSystemObject

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[DougP]

Ok Thanks

DougP

 

[DougP]

You know What? This is very powerful. Being able to look at all files of a particular type across many subfolders is great. I do a “filter by selection” for a particular main folder to see all of the files and their size. And you can do a filter by selection on a file extension after that. And on and on. Then sort File size column by Descending to see the largest file.
I created buttons to open the file and browse the folder its in. Then I can right click and Zip them down to save space.
Opening a file is done by double clicking it in the subform.

Private Sub Form_DblClick(Cancel As Integer)

    'open the file
    Application.FollowHyperlink Me.Folder_Name & "\" & Me.File_Name

End Sub
-------------
Private Sub cmdOpenFolder_Click()
On Error GoTo Err_cmdOpenFolder_Click


    ' open the folder using Windows Explorer
    Dim RetVal As Integer
    Dim ExplorerFilenPath As String
    ExplorerFilenPath = "explorer.exe /e," & Me.FoldersFound_subform.Form.[Folder Name]
    RetVal = Shell(ExplorerFilenPath, 1)


Exit_cmdOpenFolder_Click:
    Exit Sub

Err_cmdOpenFolder_Click:
    MsgBox Err.Description
    Resume Exit_cmdOpenFolder_Click
    
End Sub

DougP