Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Good excel code. works too good

Status
Not open for further replies.

vbcad

Technical User
Jul 12, 2002
159
0
0
US
Below is some code that works for what it was originaly intended. however all I would like to have it do now is create the list of Folders withing the main directory and only one sublevel below that. I do not need any file names just the folder names. I have attached a file to show what I would like the output to look like.
Code:
Sub prjFiles()
Workbooks.Add ' create a new workbook for the file list
    ' add headers
    Range("A1").Formula = "Project Number:"
    Range("B1").Formula = "Date Last Modified:"
    'Range("C1").Formula = "Short File Name:"
    Range("A1:B1").Font.Bold = True
    ListFilesInFolder "L:\Design\Projects", True
    ' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    r = Range("A65536").End(xlUp).Row + 1
    For Each FileItem In SourceFolder.Files
        ' display file properties
        Cells(r, 1).Formula = FileItem.Path
        Cells(r, 2).Formula = FileItem.DateLastModified
        'Cells(r, 3).Formula = FileItem.ShortName
        r = r + 1 ' next row number
    Next FileItem
    If IncludeSubfolders Then
        For Each subfolder In SourceFolder.SubFolders
            ListFilesInFolder subfolder.Path, True
        Next subfolder
    End If
    Columns("A:B").AutoFit
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    ActiveWorkbook.Saved = True
    
End Sub
 


I posted in your original thread. Sorry, company security prohibits me from opening your attachment.
Code:
Sub ListFolders(SourceFolderName as string)
    Dim FSO As Object
    Dim SourceFolder As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")

    For Each SourceFolder In FSO.GetFolder(SourceFolderName)
        Debug.Print SourceFolder.Name
    Next
    
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Thanks. forgive my ignorance a bit. Where in the code do i paste this (if at all) I tried to run it and i get an error. i did enable the microsoft scripting referance. I want the sheet to have a header that says "project number" and another header "date last modified" date column is obviuos of the data. I want the project number column to just show the folder name with no path information.
 



sorry, I missed the Subfolders object
Code:
    For Each SourceFolder In FSO.GetFolder(SourceFolderName)[b].subfolders[/b]
Debig.Print lists the folders in the Immediate Window.

just change the code to write to your worsheet is you need to.


Skip,
[sub]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue][/sub]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top