Announcement

Collapse
No announcement yet.

Displaying File 'Comments' in (Properties > Details) with Excel VBA

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Displaying File 'Comments' in (Properties > Details) with Excel VBA



    Hello All,

    I am having some issues finding a way to tell excel to pull Comments and Tags from files. I pulled the following code from another source:

    Code:
    'Force the explicit delcaration of variables
    Option Explicit
    Sub ListFiles()
        
        'Declare the variables
        Dim objFSO As Scripting.FileSystemObject
        Dim objTopFolder As Scripting.Folder
        Dim strTopFolderName As String
        
        'Insert the headers for Columns A through F
        Range("A1").Value = "File Name"
        Range("B1").Value = "File Size"
        Range("C1").Value = "File Type"
        Range("D1").Value = "Date Created"
        Range("E1").Value = "Date Last Accessed"
        Range("F1").Value = "Date Last Modified"
        
        'Assign the top folder to a variable
        strTopFolderName = "C:\Users\josdun\Desktop\PDFs" & "\" & ActiveSheet.Name
        
        'Create an instance of the FileSystemObject
        Set objFSO = CreateObject("Scripting.FileSystemObject")
        
        'Get the top folder
        Set objTopFolder = objFSO.GetFolder(strTopFolderName)
        
        'Call the RecursiveFolder routine
        Call RecursiveFolder(objTopFolder, True)
        
        'Change the width of the columns to achieve the best fit
        Columns.AutoFit
        
    End Sub
    Sub RecursiveFolder(objFolder As Scripting.Folder, _
        IncludeSubFolders As Boolean)
        'Declare the variables
        Dim objFile As Scripting.File
        Dim objSubFolder As Scripting.Folder
        Dim NextRow As Long
        
        'Find the next available row
        NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
        
        'Loop through each file in the folder
        For Each objFile In objFolder.Files
        If InStr(1, objFile.Name, ".pdf") Then
            Cells(NextRow, "A").Value = objFile.Name
            Cells(NextRow, "B").Value = objFile.Size
            Cells(NextRow, "C").Value = objFile.Type
            Cells(NextRow, "D").Value = objFile.DateCreated
            Cells(NextRow, "E").Value = objFile.DateLastAccessed
            Cells(NextRow, "F").Value = objFile.DateLastModified
            
            NextRow = NextRow + 1
        End If
        Next objFile
        
        'Loop through files in the subfolders
        If IncludeSubFolders Then
            For Each objSubFolder In objFolder.SubFolders
                Call RecursiveFolder(objSubFolder, True)
            Next objSubFolder
        End If
        
    End Sub

    I have been using it to get the Name, Size, Type, and relevant Dates associated with files in a folder. However, this doesn't seem to work with finding Comments, Tags, etc.

    I have found functions that are used to pull Comments and Tags from files but haven't been able to incorporate them in to the code I already have. I would greatly appreciate it if someone could show me how to do this.



    Thank you all in advance. Help is much appreciated.

  • #2
    Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

    Hi..

    The attached file will show you how to:

    a) Display all known file Attribute number designations in Column A.

    b) Display the Filename in Column B... the Attribute Name in Column C and the Attribute value for each file in Column D.

    btw.. this is from code i found in about 3 seconds via google (not kidding.. it was 3rd link on the first page..).. the key google search term being:

    excel + Scripting.File + file attributes + vba

    Google is your friend

    Heres the link:
    http://stackoverflow.com/questions/5...ile-attributes

    Note: Just change the following line to reference a filepath on your PC...
    Code:
    Dim oDir:   Set oDir = oShell.Namespace("C:\Users\apo\Desktop\Excel Test Files")
    Code:
    Private Sub CommandButton1_Click()
    ' Show all known file attribute number designations..
    Dim sFile As Variant
    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir:   Set oDir = oShell.Namespace("C:\Users\apo\Desktop\Excel Test Files")
    Dim a As String
    For i = 0 To 286
       Cells(i + 1, 1).Value = oDir.GetDetailsOf(oDir.Items, i) & " = " & i
    Next
    End Sub
    
    
    
    
    Private Sub CommandButton2_Click()
    'Show Filename, Attribute Name and Attribute Value in Columns B,C,D
    Dim sFile As Variant
    Dim oShell: Set oShell = CreateObject("Shell.Application")
    Dim oDir:   Set oDir = oShell.Namespace("C:\Users\apo\Desktop\Excel Test Files")
    Dim j As Long
    Dim AttribName As Long
    AttribName = InputBox(Prompt:="Enter Attribute Value (0-266).")
    j = 1
    For Each sFile In oDir.Items
       Cells(j, 2).Value = oDir.GetDetailsOf(sFile, 0)
       Cells(j, 3).Value = oDir.GetDetailsOf(oDir.Items, AttribName)
       Cells(j, 4).Value = oDir.GetDetailsOf(sFile, AttribName)
       j = j + 1
    Next
    End Sub
    Also.. just noticed in your code.. you can shorten this..

    Code:
     'Insert the headers for Columns A through F
        Range("A1").Value = "File Name"
        Range("B1").Value = "File Size"
        Range("C1").Value = "File Type"
        Range("D1").Value = "Date Created"
        Range("E1").Value = "Date Last Accessed"
        Range("F1").Value = "Date Last Modified"
    to be just this.. (replace "YourSheetName" with your actual sheet..)

    Code:
    Sheets("YourSheetName").Cells(1, 1).Resize(1, 6).Value = Array("File Name", "File Size", "File Type", "Date Created", "Date Last Accessed", "Date Last Modified")
    Attached Files
    Last edited by apo; September 24th, 2013, 22:29.
    Valuable Resources:

    snb's Website:
    http://www.snb-vba.eu/index_en.html

    Smallmans Website:
    http://www.thesmallman.com/

    Comment


    • #3
      Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

      Hello,

      Thank you for your answer! unfortunately I have been very busy this week and have been unable to try this out yet. I will get back o you promptly as soon as I do.

      Thanks again!

      Comment


      • #4
        Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

        Hello, I have tried the code that I was provided and it works wonderfully when obtaining the Comments from files!

        However, I would like to integrate the code with my original code on the first post so that the comments appear in line with the data that the first code gathers.

        I am having trouble doing this because both codes call different application objects (not quite sure if thats what they are called), oShell and scripting.filesystemobject and the variables from each code depend on these objects. If someone could tell me how I can use these two codes in unison I would be grateful.

        Thank you again!


        Originally posted by fun4all View Post
        Hello,

        Thank you for your answer! unfortunately I have been very busy this week and have been unable to try this out yet. I will get back o you promptly as soon as I do.

        Thanks again!

        Comment


        • #5
          Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

          Hi..

          All new to me.. but this does what you want I think..

          Note: I commented out the part that wanted pdf files.. (for testing).. I also noticed that the Comments and Tags coudl not be read on a xlsm file (but could be read in a xls file)..

          Code:
          Private Sub CommandButton1_Click()
             'Declare the variables
              Dim objFSO As Scripting.FileSystemObject
              Dim objTopFolder As Scripting.Folder
              Dim strTopFolderName As String
               
               'Insert the headers for Columns A through F
              Range("A1").Value = "File Name"
              Range("B1").Value = "File Size"
              Range("C1").Value = "File Type"
              Range("D1").Value = "Date Created"
              Range("E1").Value = "Date Last Accessed"
              Range("F1").Value = "Date Last Modified"
              Range("F1").Value = "Tags"
              Range("G1").Value = "Comments"
               
               'Assign the top folder to a variable
              strTopFolderName = "C:\Users\apo\Desktop\Excel Test Files" '& "\" & ActiveSheet.Name
               
               'Create an instance of the FileSystemObject
              Set objFSO = CreateObject("Scripting.FileSystemObject")
               
               'Get the top folder
              Set objTopFolder = objFSO.GetFolder(strTopFolderName)
               
               'Call the RecursiveFolder routine
              Call RecursiveFolder(objTopFolder, True)
               
               'Change the width of the columns to achieve the best fit
              Columns.AutoFit
          End Sub
          And in a Module..

          Code:
          Sub RecursiveFolder(objFolder As Scripting.Folder, _
              IncludeSubFolders As Boolean)
              Dim objSubFolder As Scripting.Folder
              Dim NextRow As Long
              Dim txt
              txt = objFolder
              'Find the next available row
              NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
              'Show Filename, Attribute Name and Attribute Value in Columns B,C,D
          Dim sFile As Variant
          Dim oShell: Set oShell = CreateObject("Shell.Application")
          Dim oDir:   Set oDir = oShell.Namespace(txt)
             'Loop through each file in the folder
              For Each sFile In oDir.Items
          '        If InStr(1, objFile.Name, ".pdf") Then
                      Cells(NextRow, "A").Value = oDir.GetDetailsOf(sFile, 0)
                      Cells(NextRow, "B").Value = oDir.GetDetailsOf(sFile, 1)
                      Cells(NextRow, "C").Value = oDir.GetDetailsOf(sFile, 2)
                      Cells(NextRow, "D").Value = oDir.GetDetailsOf(sFile, 4)
                      Cells(NextRow, "E").Value = oDir.GetDetailsOf(sFile, 5)
                      Cells(NextRow, "F").Value = oDir.GetDetailsOf(sFile, 18)
                      Cells(NextRow, "G").Value = oDir.GetDetailsOf(sFile, 24)
          
          
                      NextRow = NextRow + 1
          '        End If
              Next
               'Loop through files in the subfolders
              If IncludeSubFolders Then
                  For Each objSubFolder In objFolder.SubFolders
                      Call RecursiveFolder(objSubFolder, True)
                  Next objSubFolder
              End If
          End Sub
          or the following does the same thing.. not a huge saving in code lines.. but if you were to want to populate a heap more columns with more attributes.. then all you need to do is add the attribute number into the array...

          Code:
          Sub RecursiveFolder(objFolder As Scripting.Folder, _
              IncludeSubFolders As Boolean)
              Dim objSubFolder As Scripting.Folder
              Dim NextRow As Long, c As Long
              Dim txt: txt = objFolder
              Dim vArr As Variant, sFile As Variant
              Dim oShell: Set oShell = CreateObject("Shell.Application")
              Dim oDir:   Set oDir = oShell.Namespace(txt)
              
             NextRow = Cells(Rows.Count, "A").End(xlUp).Row + 1
             vArr = Array(0, 1, 2, 4, 5, 18, 24)
             'Loop through each file in the folder
              For Each sFile In oDir.Items
              c = 1
                For j = LBound(vArr) To UBound(vArr)
          '        If InStr(1, objFile.Name, ".pdf") Then
                       Cells(NextRow, c).Value = oDir.GetDetailsof(sFile, vArr(j))
                       c = c + 1
                Next j
                      NextRow = NextRow + 1
          '        End If
              Next
               'Loop through files in the subfolders
              If IncludeSubFolders Then
                  For Each objSubFolder In objFolder.SubFolders
                      Call RecursiveFolder(objSubFolder, True)
                  Next objSubFolder
              End If
          End Sub
          Last edited by apo; September 29th, 2013, 14:20.
          Valuable Resources:

          snb's Website:
          http://www.snb-vba.eu/index_en.html

          Smallmans Website:
          http://www.thesmallman.com/

          Comment


          • #6
            Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

            These all work great! Thanks everyone

            Comment


            • #7
              Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

              If you need some background:

              http://www.snb-vba.eu/VBA_Bestanden_en.html

              Comment


              • #8
                Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

                wow... great resource snb.. bookmarked!
                Valuable Resources:

                snb's Website:
                http://www.snb-vba.eu/index_en.html

                Smallmans Website:
                http://www.thesmallman.com/

                Comment


                • #9


                  Re: Displaying File 'Comments' in (Properties > Details) with Excel VBA

                  I hope this isn't too old of a thread. I'm trying to use the code in the forum but none of it is working and I'm not quite understanding the link posted by snb.

                  I'm attempting to get the Extended Properties as well but nothing I try works even though the code here was verified as working.

                  Code:
                  Sub FileDetails()   
                  
                  
                  'Pulls in name for each file in specified folder location
                  
                  
                  Dim ctr As Integer
                  Dim path As Variant
                  Dim file As Variant
                  
                  
                  ctr = 1
                  'path = "J:\DefaultManagement\Timeline Management\Foreclosure Bid Approval\JFIGS\ "   ' Path should always contain a '\' at end
                  path = "P:\Rejected\"
                  file = Dir(path)    ' Retrieving the first entry.
                  Do Until file = ""   ' Start the loop.
                    Worksheets("Folder").Cells(ctr + 1, 1).Value = file
                    
                    ctr = ctr + 1
                    file = Dir()   ' Getting next entry.
                  Loop
                  
                  
                  
                  
                  End Sub

                  Comment

                  Working...
                  X