Excel VB - Shell object and Items extended properties - excel

Question

First of all i'm not a VB geek, but I've found my way through googling around and I just can't figure out this one...
Put simply, I made a macro that allows me to select pdfs, zip them, and build a list of those zipped files on another sheet, then automatically prepares an email with that zip as an attachment. I want that list to contain the following entries:
The file name without the path, and without the extension (done and code works, though I've read that I may have issues if "hide extension of know file type" is activated, not tested);
Then each file name is hyperlinked to the actual file location before being zipped (done and code works);
The document title, which is an extended property (title metadata) of the pdf (WITHOUT having Acrobat installed, done and code works);
The document Tags (or Keywords?), again extended property of the pdf. It's this one that I need help with!. I browsed through office documentations and just can't find the info I need.
Like I said, I'm not a coder, I know my code is not optimal so please don't judge me. I just want it to work, then I'll optimize it ;)
To get the title property I use the following code :
Sheet1.Range("F54").Value = oShell.Namespace("FOLDERPATH").Items.Item("FILE IN FOLDERPATH).ExtendedProperty("DocTitle")
"DocTitle" is the property name for the title. I just can't find what it is to extract "Tags", I've tried "Tags", "DocTags" and "Keywords" and I got nothing. I've tried using GetDetailsOf("FILE", 18), but it returns the string "Tags", not the actual tags...like... the title of the tags...
Here is the full code :
Option Explicit
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Milliseconds As LongPtr)
Sub ZipAndEmailFiles() 'By selecting individually
Dim CurDateTime As String
Dim DefaultFilePath As String
Dim FilesToZip As String
Dim oShell: Set oShell = CreateObject("Shell.Application")
Dim FileCount As Long
Dim FileNumb As Integer
Dim LastZipNumb As Integer
Dim FileNames As Variant
Dim VArr As Variant
Dim ZipFileName As Variant
Dim ProjectNumb As String
LastZipNumb = Main.Range("C13").Value 'Get last qty of file(s) zipped
CurDateTime = Format(Now, "yyyy-mmm-dd h-mm-ss") 'Get actual date and time
DefaultFilePath = Application.DefaultFilePath
If Right(DefaultFilePath, 1) <> "\" Then DefaultFilePath = DefaultFilePath & "\"
ProjectNumb = Main.Range("C4").Value 'Get project number (Entry by user)
ZipFileName = DefaultFilePath & ProjectNumb & "-" & CurDateTime & ".zip" 'Name of zip
'Browse For Files & Select Multiple files
FileNames = Application.GetOpenFilename("PDF Files (*.pdf),*.pdf", MultiSelect:=True, Title:="Select Files you want to Zip & Email")
If IsArray(FileNames) = False Then Exit Sub
'Create Empty Zipped File in DefaultFilePath
If Len(Dir(ZipFileName)) > 0 Then Kill ZipFileName
Open ZipFileName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
FileNumb = 0
'Clear cells from previous list
For FileCount = 1 To LastZipNumb
FileNumb = FileNumb + 1
ThisWorkbook.Worksheets("Transmittal").Range("B54:F54").Offset(2 * (FileNumb - 1), 0).Clear
Next
FileNumb = 0
'Build list & Fill zip
For FileCount = LBound(FileNames) To UBound(FileNames)
FileNumb = FileNumb + 1
'Insert name of each processed file, removing path, revision and extension
Transmittal.Range("B54").Offset(2 * (FileNumb - 1), 0).Value = Left(GetFilenameFromPath(FileNames(FileNumb)), 12)
'Create hyperlink to reference file being zipped
ActiveSheet.Hyperlinks.Add Transmittal.Range("B54").Offset(2 * (FileNumb - 1), 0), FileNames(FileNumb)
'Inscrire le titre dans la case indiquée
'Transmittal.Range("F54").Offset(2 * (FileNumb - 1), 0).Value = oShell.Namespace(FolderFromPath(FileNames(FileNumb))).GetDetailsOf(FileNameFromPath(FileNames(FileNumb)), FileNumb)
Transmittal.Range("D54").Offset(2 * (FileNumb - 1), 0).Value = oShell.Namespace(FolderFromPath(FileNames(FileNumb))).Items.Item(FileNameFromPath(FileNames(FileNumb))).ExtendedProperty("Keywords")
Transmittal.Range("F54").Offset(2 * (FileNumb - 1), 0).Value = oShell.Namespace(FolderFromPath(FileNames(FileNumb))).Items.Item(FileNameFromPath(FileNames(FileNumb))).ExtendedProperty("DocTitle")
'Copy said file in zip
oShell.Namespace(ZipFileName).CopyHere FileNames(FileCount)
'Keep Script waiting until compressing is done
On Error Resume Next
Do Until oShell.Namespace(ZipFileName).Items.Count = FileNumb
Sleep (100) 'Wait 100ms after each copied file
Loop
On Error GoTo 0
Next FileCount
Main.Range("C22").Value = ZipFileName 'Place zip location, to be attached to email
Main.Range("C13").Value = UBound(FileNames)
EmailZipFile
End Sub
Sub EmailZipFile()
Dim OutApp As Object
Dim OutEmail As Object
Set OutApp = CreateObject("Outlook.application")
Set OutEmail = OutApp.CreateItem(0)
With OutEmail
.To = Main.Range("C13").Value ' Email
If Main.Range("C16").Value <> "" Then .Attachments.Add Main.Range("C16").Value 'Zipped file
.Subject = Main.Range("C15").Value 'Email subject
.Body = Main.Range("C17").Value 'Email body
.Display 'Show Outlook windows
End With
End Sub
Function FileNameFromPath(ByVal strPath As String) As String
FileNameFromPath = Right(strPath, Len(strPath) - InStrRev(strPath, "\"))
End Function
Function FolderFromPath(ByVal strPath As String) As String
FolderFromPath = Left(strPath, InStrRev(strPath, "\"))
End Function
For the code to fully work, you have to have Outlook installed. But even without Outlook, the list generation works. Thanks for your help, and your time!