Excel VBA File Properties

Sub Show_Properties()
    Dim wb As Workbook
    Set wb = ThisWorkbook 'or set it to another workbook using Workbooks.Open or Workbooks.Add
    
    'Read the built-in document properties
    Dim msg As String
    msg = "Title: " & wb.BuiltinDocumentProperties("Title") & vbCrLf & _
          "Author: " & wb.BuiltinDocumentProperties("Author") & vbCrLf & _
          "Subject: " & wb.BuiltinDocumentProperties("Subject") & vbCrLf & _
          "Keywords: " & wb.BuiltinDocumentProperties("Keywords") & vbCrLf & _
          "Comments: " & wb.BuiltinDocumentProperties("Comments") & vbCrLf & _
          "Last saved by: " & wb.BuiltinDocumentProperties("Last Author") & vbCrLf & _
          "Last saved on: " & wb.BuiltinDocumentProperties("Last Save Time")
    
    'Display the properties in a MsgBox
    MsgBox msg, vbInformation, "File Properties"

Sub Modify_Properties()
    Dim wb As Workbook
    Set wb = ThisWorkbook 'or set it to another workbook using Workbooks.Open or Workbooks.Add
    
    'Read the built-in document properties
    Debug.Print "Title: " & wb.BuiltinDocumentProperties("Title")
    Debug.Print "Author: " & wb.BuiltinDocumentProperties("Author")
    Debug.Print "Subject: " & wb.BuiltinDocumentProperties("Subject")
    Debug.Print "Keywords: " & wb.BuiltinDocumentProperties("Keywords")
    Debug.Print "Comments: " & wb.BuiltinDocumentProperties("Comments")
    Debug.Print "Last saved by: " & wb.BuiltinDocumentProperties("Last Author")
    Debug.Print "Last saved on: " & wb.BuiltinDocumentProperties("Last Save Time")
    
    'Modify the built-in document properties
    wb.BuiltinDocumentProperties("Title") = "Solved Excel"
    wb.BuiltinDocumentProperties("Author") = "Solved Excel"
    wb.BuiltinDocumentProperties("Subject") = "Your Excel Coach"
    wb.BuiltinDocumentProperties("Keywords") = "Excel"
    wb.BuiltinDocumentProperties("Comments") = "Find Easy Solution"
    
    'Save the changes
    wb.Save
 MsgBox "File Properties Changed", vbInformation, "File Properties"
End Sub

Sub Get_File_Properties()

    'Specify the file path
    Dim filePath As String
    filePath = ThisWorkbook.Sheets(3).Range("G6").Value

    'Select the worksheet to save the file properties
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(3)

    'Set column headers
    ws.Range("A1").Value = "Property"
    ws.Range("B1").Value = "Value"

    'Declare variables
    Dim Shellobj As Object
    Dim Folderobj As Object
    Dim FolderItemobj As Object
    Dim i As Integer
    
    'Create a Shell object
    Set Shellobj = CreateObject("Shell.Application")
    
    'Get the folder object
    Set Folderobj = Shellobj.Namespace(Left(filePath, InStrRev(filePath, "\")))
    
    'Get the folder item object for the file
    Set FolderItemobj = Folderobj.ParseName(Right(filePath, Len(filePath) - InStrRev(filePath, "\")))
    
    'Loop through the properties and add them to the worksheet
    For i = 0 To 39
        ws.Range("A" & i + 2).Value = Folderobj.GetDetailsOf(Folderobj.Items, i)
        ws.Range("B" & i + 2).Value = Folderobj.GetDetailsOf(FolderItemobj, i)
    Next i
    
    'Save the workbook
    ThisWorkbook.Save

End Sub