Snasui Excel Forum

Code: Select all

Dim iRow
Dim Counter
Dim myFile As Scripting.File

Sub ListFiles()
    On Error Resume Next
    Call Setup
    Call ListMyFiles(Range("Folder"), Range("Include_Subfolders"))
    Call SortRange
    Call HideUnwantedCols
    Call DisplayOrder
    Call RefreshPivot
End Sub


Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Dim MyObject As Scripting.FileSystemObject
    
    On Error Resume Next
    Set MyObject = New Scripting.FileSystemObject
    Set mySource = MyObject.GetFolder(mySourcePath)
    
    For Each myFile In mySource.Files
        Counter = 1
        For i = 1 To 11
            Call GetAttribute(i)
        Next
        If iRow > Range("Stop_After") Then Exit Sub
        Application.StatusBar = "File Number: " & iRow
        iRow = iRow + 1
    Next
    If IncludeSubfolders Then
        For Each mySubFolder In mySource.SubFolders
            Call ListMyFiles(mySubFolder.Path, True)
        Next
    End If
End Sub

Sub Setup()
    Sheets("Files").Select
    Cells.ClearContents
    Cells.EntireColumn.Hidden = False
    iCol = 1
    iRow = 2
    Cells(1, iCol) = "Attributes"
    iCol = iCol + 1
    Cells(1, iCol) = "DateCreated"
    iCol = iCol + 1
    Cells(1, iCol) = "DateLastAccessed"
    iCol = iCol + 1
    Cells(1, iCol) = "DateLastModified"
    iCol = iCol + 1
    Cells(1, iCol) = "Drive"
    iCol = iCol + 1
    Cells(1, iCol) = "Name"
    iCol = iCol + 1
    Cells(1, iCol) = "ParentFolder"
    iCol = iCol + 1
    Cells(1, iCol) = "Path"
    iCol = iCol + 1
    Cells(1, iCol) = "ShortName"
    iCol = iCol + 1
    Cells(1, iCol) = "Size"
    iCol = iCol + 1
    Cells(1, iCol) = "Type"

    For iCol = 1 To 11
        Columns(iCol).NumberFormat = Range("Format").Offset(iCol).NumberFormat
    Next

End Sub

Function GetAttribute(AttributeNumber)
        If Range("What_To_Show").Offset(Counter, 0).Font.Bold = True Then
            Select Case AttributeNumber
                Case 1
                    Cells(iRow, Counter).Value = myFile.Attributes
                Case 2
                    Cells(iRow, Counter).Value = myFile.DateCreated
                Case 3
                    Cells(iRow, Counter).Value = myFile.DateLastAccessed
                Case 4
                    Cells(iRow, Counter).Value = myFile.DateLastModified
                Case 5
                    Cells(iRow, Counter).Value = myFile.Drive
                Case 6
                    Cells(iRow, Counter).Value = myFile.Name
                Case 7
                    Cells(iRow, Counter).Value = myFile.ParentFolder
                Case 8
                    Cells(iRow, Counter).Value = myFile.Path
                Case 9
                    Cells(iRow, Counter).Value = myFile.ShortName
                Case 10
                    Cells(iRow, Counter).Value = myFile.Size
                Case 11
                    Cells(iRow, Counter).Value = myFile.Type
            End Select
        End If
        Counter = Counter + 1
End Function

Sub SortRange()
    With ActiveWorkbook.Worksheets("Files").Sort
        .SortFields.Clear
        For i = 1 To 11
        Set rngFoundIt = Sheets("Main").Columns(Range("Sort_Order").Column).Find(i, LookIn:=xlValues, LookAt:=xlWhole)
            If Not rngFoundIt Is Nothing Then
                .SortFields.Add Key:=Cells(2, rngFoundIt.Row - Range("Sort_Order").Row), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            End If
        Next
        .SetRange Range("A1").CurrentRegion
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Cells.EntireColumn.AutoFit
End Sub

Sub DisplayOrder()

End Sub

Sub HideUnwantedCols()
    For i = 1 To 11
        If Range("What_To_Show").Offset(i, 0).Font.Bold = False Then
            Sheets("files").Columns(i).Hidden = True
        End If
    Next
End Sub

Sub RefreshPivot()
    Sheets("pivot").Select
    ActiveSheet.PivotTables(1).PivotCache.Refresh
End Sub
Sub GotoFirstPage()
    Sheet("FirstPage").Select
    Range("h5").Select

End Sub

Code: Select all

Call GotoFirstPage

Code: Select all

Sub GotoFirstPage()
    Sheet("FirstPage").Select
    Range("h5").Select
End Sub

Code: Select all

Sub GotoFirstPage()
    Sheets("FirstPage").Select
    Range("h5").Select
End Sub

Code: Select all

Sheets("FirstPage").Select
    Range("h5").Select