This is fairly straightforward apart from the Publish Date, which is not as readily accessible as the other property fields.
However the following will work. It takes no account of existing filenames of the same name nor illegal filename characters beyond those addressed in the particular examples.
There are code examples on my web site to cover both issues should you require them. http://www.gmayor.com/useful_vba_functions.htm

The code does not rename the folder, but creates a new one with the required name.

Option Explicit

Sub MySave()
Dim strFname As String
Dim strPDFName As String
Dim strPath As String
Const strDrive As String = "C:\"
    strPath = Trim(ActiveDocument.BuiltInDocumentProperties("Title").Value) & "_"
    strPath = strPath & Replace(Trim(ActiveDocument.BuiltInDocumentProperties("Comments").Value), "/", ".") & Chr(32)
    strPDFName = strPath & Replace(Trim(ActiveDocument.BuiltInDocumentProperties("Company").Value), "-", "")
    strPath = strPath & Trim(ActiveDocument.BuiltInDocumentProperties("Author").Value) & Chr(32)
    strPath = strPath & Replace(Trim(ActiveDocument.BuiltInDocumentProperties("Company").Value), "-", "")
    strFname = strPath
    strPath = strDrive & strPath & " - " & GetPublishDate & "\"
    'MsgBox strPath & vbCr & strFname & vbCr & strPDFName
    CreateFolders strPath
    ActiveDocument.SaveAs2 strPath & strFname & ".docx"
    ActiveDocument.ExportAsFixedFormat OutputFilename:=strPath & strPDFName & ".pdf", _
                                       ExportFormat:=wdExportFormatPDF, _
                                       OpenAfterExport:=False, _
                                       OptimizeFor:=wdExportOptimizeForPrint, _
                                       Range:=wdExportAllDocument, From:=1, To:=1, _
                                       Item:=wdExportDocumentContent, _
                                       IncludeDocProps:=True, _
                                       KeepIRM:=True, _
                                       CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                                       DocStructureTags:=True, _
                                       BitmapMissingFonts:=True, _
                                       UseISO19005_1:=False
lbl_Exit:
    Exit Sub
End Sub

Private Function GetPublishDate() As String
'Graham Mayor
Dim oCustPart As CustomXMLPart
Dim oNode As CustomXMLNode
Dim pXPath As String
    pXPath = "/ns0:CoverPageProperties[1]/ns0:PublishDate[1]"
    Set oCustPart = ActiveDocument.CustomXMLParts(3)
    Set oNode = oCustPart.SelectSingleNode(pXPath)
    GetPublishDate = oNode.Text
    Set oCustPart = Nothing
    Set oNode = Nothing
lbl_Exit:
    Exit Function
End Function

Private Function CreateFolders(strPath As String)
'Graham Mayor
'Create any missing folders in a named file path
Dim strTempPath As String
Dim lngPath As Long
Dim vPath As Variant
    vPath = Split(strPath, "\")
    strPath = vPath(0) & "\"
    For lngPath = 1 To UBound(vPath)
        strPath = strPath & vPath(lngPath) & "\"
        If Not FolderExists(strPath) Then MkDir strPath
    Next lngPath
lbl_Exit:
    Exit Function
End Function

Private Function FolderExists(strFolderName As String) As Boolean
'Graham Mayor
'strFolderName is the name of folder to check
   Dim fso As Object
   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FolderExists(strFolderName)) Then
      FolderExists = True
   Else
      FolderExists = False
   End If
lbl_Exit:
    Exit Function
End Function