Get Author properties

[TheJocker1236]

This code get me the path, filename, filesize etc..
But I want also to it to return the Author ao files if they exists can anyone help me?

Option Explicit
'the first row with data
Const ROW_FIRST As Integer = 5

'This is an event handler. It exectues when the user
'presses the run button
 Sub btnGet_Click()

    'determines if the user selects a directory
    'from the folder dialog
    Dim intResult As Integer

    'the path selected by the user from the
    'folder dialog
    Dim strPath As String

    'Filesystem object
    Dim objFSO As Object

    'the current number of rows
    Dim intCountRows As Integer
    
    Application.FileDialog(msoFileDialogFolderPicker).Title = _
    "Select a Path"
    
    'the dialog is displayed to the user
    intResult = Application.FileDialog( _
    msoFileDialogFolderPicker).Show
    
    'checks if user has cancled the dialog
    If intResult <> 0 Then
        strPath = Application.FileDialog(msoFileDialogFolderPicker _
        ).SelectedItems(1)
    
         'Create an instance of the FileSystemObject
        Set objFSO = CreateObject("Scripting.FileSystemObject")
   
         'loops through each file in the directory and prints their
         'names and path
         intCountRows = GetAllFiles(strPath, ROW_FIRST, objFSO)
    
         'loops through all the files and folder in the input path
         Call GetAllFolders(strPath, objFSO, intCountRows)
            
            Range("A1").Value = "File Name"
            Range("B1").Value = "File Path"
            Range("C1").Value = "File Size"
            Range("D1").Value = "Autor"
            Range("E1").Value = "Last Change"
            Range("F1").Value = "Created Date"
            Range("A1").Font.FontStyle = "Bold" 'Turns the cell into Bold fontstyle
            Range("B1").Font.FontStyle = "Bold" 'Turns the cell into Bold fontstyle
            Range("C1").Font.FontStyle = "Bold" 'Turns the cell into Bold fontstyle
            Range("D1").Font.FontStyle = "Bold" 'Turns the cell into Bold fontstyle
            Range("E1").Font.FontStyle = "Bold" 'Turns the cell into Bold fontstyle
            Range("F1").Font.FontStyle = "Bold" 'Turns the cell into Bold fontstyle
            
            Columns.AutoFit 'It automatically fit the Cells to the wanted size.
    End If
    
    'Columns.AutoFit
    
End Sub

'''
'This function prints the name and path of all the files
'in the directory strPath
'strPath: The path to get the list of files from
'intRow: The current row to start printing the file names
'in
'objFSO: A Scripting.FileSystem object.
 Function GetAllFiles(ByVal strPath As String, _
    ByVal intRow As Integer, ByRef objFSO As Object) As Integer
        Dim objFolder As Object
        Dim objFile As Object
        Dim SubFolder As Object
        Dim i As Integer
        i = Cells(Rows.Count, "A").End(xlUp).Row + 1
        Set objFolder = objFSO.GetFolder(strPath)
       
      
        For Each objFile In objFolder.Files
            'print file name
            Cells(i, "A").Value = objFile.Name
            'print file path
            'Cells(i, "B").Value = objFile.Path
            Cells(i, "C").Value = objFile.Size
            'Cells(i, "D").Value = objFile.Author
           
         Dim DoubleBytes As Double 'Saves the value of the given size.
            Select Case objFile.Size
                Case 0 To 1023
                    DoubleBytes = objFile.Size ' bytes
                    Cells(i, "C").Value = Format(DoubleBytes / 1, "0") & "B"
                Case 1024 To 1048575
                    DoubleBytes = CDbl(objFile.Size / 1024) 'KB
                    Cells(i, "C").Value = Format(DoubleBytes / 1, "0.00") & "KB"
                Case 1048576 To 1073741823
                    DoubleBytes = CDbl(objFile.Size / 1048576) 'MB
                    Cells(i, "C").Value = Format(DoubleBytes / 1, "0.00") & "MB"
                Case 1073741824 To 1099511627775#
                    DoubleBytes = CDbl(objFile.Size / 1048576) 'GB
                    Cells(i, "C").Value = Format(DoubleBytes / 1, "0.00") & "GB"
                Case Is >= 1099511627776#
                    DoubleBytes = CDbl(objFile.Size / 1099511627776#) 'TB
                    Cells(i, "C").Value = Format(DoubleBytes / 1, "0.00") & "TB"
            End Select
            Cells(i, "E").Value = objFile.DateLastModified
            Cells(i, "F").Value = objFile.DateCreated
              
        'For Each SubFolder In objFolder.Path
        Cells(i, "B").Value = objFolder
            
            
            i = i + 1 'goes to the next rows of cells
        Next objFile
        GetAllFiles = i + ROW_FIRST - 1
End Function

'''
'This function loops through all the folders in the
'input path. It makes a call to the GetAllFiles
'function. It also makes a recursive call to itself
'strFolder: The folder to loop through
'objFSO: A Scripting.FileSystem object
'intRow: The current row to print the file data on
 Sub GetAllFolders(ByVal strFolder As String, _
    ByRef objFSO As Object, ByRef intRow As Integer)
        
        Dim objFolder As Object
        Dim objSubFolder As Object

        'Get the folder object
        Set objFolder = objFSO.GetFolder(strFolder)

        'loops through each file in the directory and
        'prints their names and path
        For Each objSubFolder In objFolder.SubFolders
            intRow = GetAllFiles(objSubFolder.Path, _
            intRow, objFSO)
            
            'recursive call to to itsself
            Call GetAllFolders(objSubFolder.Path, _
                objFSO, intRow)
        Next objSubFolder
End Sub

 

[igold]

Hi,

Without going through your entire code, consider this:

This code will return the Author of the current workbook.

Sub test()
    Dim DocProp1 As String
    DocProp1 = ThisWorkbook.BuiltinDocumentProperties("author")
End Sub

I hope this helps.

igold