VBA .Getdetailsof

biubiubiu

New Member
Joined
Jul 5, 2016
Messages
43
Hey guys, :)

I currently have two related problems when running a macro, hopefully someone that is more experienced than me can figure this out:

Purpose of the macro: read all files within a folder (and subfolders), list various file attributes ofeach file (file size, author etc.) on a worksheet.


Rich (BB code):
'Option Explicit
Public FSO As New FileSystemObject
Private FileType As Variant

Sub ListHyperlinkFilesInSubFolders()
   

    
    
    Dim startingcell As Range 'Cell where hyperlinked list starts
    Dim FSOFolder As Folder
    Dim RootFolder As String
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    

    'Ask for folder to list files from
    With Application.FileDialog(msoFileDialogFolderPicker)
    
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Please select folder to list files from"
        .Show
    
        'If a folder has been selected
        If .SelectedItems.Count <> 0 Then
        
            RootFolder = .SelectedItems(1)
            
            Set FSOFolder = FSO.GetFolder(RootFolder)
            
            'Ask what type of files to look for
            FileType = Application.InputBox("* and ? wildcards are valid " & vbCrLf & vbCrLf & " e.g. .xls* to list XLS, XLSX and XLSM" _
                        & vbCrLf & vbCrLf & "??st.* to list West.xlsx and East.xlsx" & vbCrLf & vbCrLf & "Just click OK to list all files.", _
                        "What type of files do you want to list?", "")
                        
            If FileType = False Then 'Cancel pressed
                
                MsgBox "Process Cancelled"
                Exit Sub
            ElseIf FileType = vbNullString Then 'Nothing entered and OK pressed
                FileType = "*.*"
            
            End If
            
            'Clear the active sheet to remove previous results
            'ActiveSheet.Cells.Clear
            'Enter default message in case no files are in folder
            'With Range(StartingCell)
            
                '.ClearFormats
                '.Value = "No " & FileType & " files found in " & RootFolder
                '.Select
                
            'End With
            
            ' Call recursive sub to list files
            ListFilesInSubFolders FSOFolder
    
            'Autofit the columns containing our results
            Columns.AutoFit
            
        Else
        
            'If no folder selected, admonish user for wasting CPU cycles :)
            MsgBox "No folder selected.", vbExclamation
        
        End If
    End With

    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
  
  Sheet2.Range ("A1 activate")
 
    
    
End Sub
 
Sub ListFilesInSubFolders(StartingFolder As Scripting.Folder)

    
    Dim CurrentFilename As String
    Dim OffsetRow As Long
    Dim TargetFiles As String
    Dim SubFolder As Scripting.Folder
    Dim foldername As String
    Dim startingcell As Range
    Dim endcell As Range
    Dim cell As Variant
    Dim firstrow As Integer
    Dim lastrow As Integer
    Dim x As Variant
    
    Dim Modcol As Integer, Linkcol As Integer, Datecol As Integer, Foldernamecol As Integer, OPcol As Integer
    Dim Typecol As Integer, Authorcol As Integer, Titlecol As Integer, Subjcol As Integer
    Dim CCcol As Integer, FROMcol As Integer, TOcol As Integer
    
    
    Sheet2.Activate
    'Write name of folder to cell
    foldername = StartingFolder.Path
    
    'get starting row
    Set startingcell = Sheets(2).Range("A99999").End(xlUp).Offset(1)
    ' find firstrow
    firstrow = startingcell.Row
    
    'find out where to insert info - find the correct columns
    Modcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Last date modified", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Foldernamecol = Sheet2.Cells(1, 1).EntireRow.find(What:="Folder name", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Linkcol = Sheet2.Cells(1, 1).EntireRow.find(What:="hyperlink", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Datecol = Sheet2.Cells(1, 1).EntireRow.find(What:="Date added", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    'OPcol = Sheet2.Cells(1, 1).EntireRow.Find(What:="operator", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Typecol = Sheet2.Cells(1, 1).EntireRow.find(What:="File Type", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Authorcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Author of Document", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Titlecol = Sheet2.Cells(1, 1).EntireRow.find(What:="Document Title", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    Subjcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Subject of Email", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    CCcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Email CC", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    FROMcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Email Sender", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    TOcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Email Recipient", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    'Createcol = Sheet2.Cells(1, 1).EntireRow.find(What:="Date Created", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    PageCol = Sheet2.Cells(1, 1).EntireRow.find(What:="Number of Pages", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    SlideCol = Sheet2.Cells(1, 1).EntireRow.find(What:="Number of Slides", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Column
    
'Get the first file, look for Normal, Read Only, System and Hidden files
    TargetFiles = StartingFolder.Path & "\" & FileType
                
            CurrentFilename = Dir(TargetFiles,7)
            
            OffsetRow = 0
            x = 1
            
            Do While CurrentFilename <> ""
            
                'Create the hyperlink
                
                
                ' need to find where the corresponding heading is
                

                startingcell.Offset(OffsetRow, Linkcol - 1).Hyperlinks.Add Anchor:=startingcell.Offset(OffsetRow, 2), Address:=StartingFolder.Path & "\" & CurrentFilename, TextToDisplay:=CurrentFilename
                startingcell.Offset(OffsetRow, Foldernamecol - 1) = foldername
                startingcell.Offset(OffsetRow, Modcol - 1) = FileDateTime(foldername + "\" + CurrentFilename)
                startingcell.Offset(OffsetRow, Datecol - 1) = Format(Date, "YYYY / mm / dd")
                          
                             
               
                
                With CreateObject("shell.application").Namespace(foldername & "\")
                startingcell.Offset(OffsetRow, Typecol - 1) = .getdetailsof(.Items.Item(x - 1), 2)
                startingcell.Offset(OffsetRow, FROMcol - 1) = .getdetailsof(.Items.Item(x - 1), 207)
                startingcell.Offset(OffsetRow, TOcol - 1) = .getdetailsof(.Items.Item(x - 1), 213)
                startingcell.Offset(OffsetRow, Subjcol - 1) = .getdetailsof(.Items.Item(x - 1), 22)
                startingcell.Offset(OffsetRow, CCcol - 1) = .getdetailsof(.Items.Item(x - 1), 202)
                startingcell.Offset(OffsetRow, Authorcol - 1) = .getdetailsof(.Items.Item(x - 1), 20)
                startingcell.Offset(OffsetRow, PageCol - 1) = .getdetailsof(.Items.Item(x - 1), 148)
                startingcell.Offset(OffsetRow, SlideCol - 1) = .getdetailsof(.Items.Item(x - 1), 149)
                End With
                
                
              
                OffsetRow = OffsetRow + 1
                x = x + 1
                'Get the next file
                CurrentFilename = Dir
        
            Loop

    ' Offset the DestinationRange one column to the right and OffsetRows down so that we start listing files
    ' inthe next folder below where we just finished. This results in an indented view of the folder structure
    Set startingcell = startingcell.Offset(OffsetRow)
    
    ' For each SubFolder in the current StartingFolder call ListFilesInSubFolders (recursive)
    ' The sub continues to call itself for each and every folder it finds until it has
    ' traversed all folders below the original StartingFolder
    For Each SubFolder In StartingFolder.SubFolders
        
        ListFilesInSubFolders SubFolder
        
    Next SubFolder
    
    
    lastrow = Sheets(2).Range("A99999").End(xlUp).Row
  
    With Range(Cells(firstrow, 1), Cells(lastrow, 19))
        .Borders.LineStyle = xlNone
 
        For Each cell In Array(xlEdgeTop, xlInsideHorizontal, xlEdgeBottom, xlLeft, xlRight)
            With .Borders(cell)
                .LineStyle = xlContinuous
                .Weight = xlThin
                .ColorIndex = xlAutomatic
            End With
        Next cell
    End With
     
    
    End Sub

I have pasted the entire code (removed some irrelevant code to improve readability), but really the problem occurs with the section in red.

First problem: I have no idea why but instead of getdetailsof(.Items.Item(x), 148) I have to use "x-1" otherwise there is a mismatch between the file and its attributes. Does the first item start from number 0? :confused:


Second problem: As opposed to the first issue which is fixable, I realised there is an overall mismatch between file and file attributes, because the dir reads "thumb.db" which is a hidden system file (see example 1 below), I tried to exclude this particular file by using dir(targetfiles,vbnormal), however there is still a mismatch.


example 1:
File 1 (JPEG) JPEG
FIle 2 (TXT) TXT

results
File 1 (JPEG) JPEG
thumb.db TXT
File 2 (TXT) folder type

with dir (, hidden)
results
File 1 (JPEG) JPEG
File 2 (TXT) folder type


p.s. Is there any other way which I can read these file attributes? While running the code, I can see from the local window that the correct file attribute is listed under startingfolder.files.items(1) etc, but I cant figure out the correct syntax to retrieve it.



Sorry if I have not done a very good job at explaining my problem, please let me know if you need further information.

thanks in advance

:)
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
Re: Please help! VBA .Getdetailsof

1. As far as I know GetDetailsOf is zero-based.

2. Not sure what you are actually asking, are you looking for a way to exclude hidden files?

PS Why are you using Dir in ListFilesInSubFolders and FSO in ListHyperlinkFilesInSubFolders? Wouldn't it be better to use FSO in both?
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top