This is fairly straightforward, but you cannot make up your own syntax and expect it to work - the first macro will add the date to all the footers and the second will create the folder (if not present) and save the document in it. Drive H: must be available and capable of being written to.
Option Explicit
'Graham Mayor - http://www.gmayor.com - Last updated - 17 Jul 2018
Sub Macro1()
Dim strDate As String
Dim oFooter As HeaderFooter
Dim oSection As Section
Dim oRng As Range
strDate = Format(Date, "yyyy mmm dd")
For Each oSection In ActiveDocument.Sections
For Each oFooter In oSection.Footers
If oFooter.Exists Then
Set oRng = oFooter.Range
oRng.Collapse 1
oRng.Text = strDate
End If
Next oFooter
Next oSection
lbl_Exit:
Set oRng = Nothing
Set oFooter = Nothing
Set oSection = Nothing
Exit Sub
End Sub
Sub Macro2()
Dim strPath As String
strPath = "H:\Projects\" & Format(Date, "yyyy") & "\"
CreateFolders strPath
ActiveDocument.SaveAs2 FileName:=strPath & Format(Date, "yyyy mmm dd") & " - Afternoon Comments.docx", _
FileFormat:=wdFormatXMLDocument, _
LockComments:=False, Password:="", _
AddToRecentFiles:=True, _
WritePassword:="", _
ReadOnlyRecommended:=False, _
EmbedTrueTypeFonts:=False, _
SaveNativePictureFormat:=False, _
SaveFormsData:=False, _
SaveAsAOCELetter:=False, _
CompatibilityMode:=15
ActiveDocument.ExportAsFixedFormat OutputFileName:=strPath & Format(Date, "yyyy mmm dd") & " - Afternoon Comments.pdf", _
ExportFormat:=wdExportFormatPDF, _
OpenAfterExport:=False, _
OptimizeFor:=wdExportOptimizeForPrint, _
Range:=wdExportAllDocument, _
From:=1, to:=1, _
Item:=wdExportDocumentContent, _
IncludeDocProps:=True, _
KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, _
DocStructureTags:=True, _
BitmapMissingFonts:=True, _
UseISO19005_1:=False
lbl_Exit:
Exit Sub
End Sub
Public Sub CreateFolders(strPath As String)
'A Graham Mayor/Greg Maxey AddIn Utility Macro
Dim oFSO As Object
Dim lng_PathSep As Long
Dim lng_PS As Long
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
lng_PathSep = InStr(3, strPath, "\")
If lng_PathSep = 0 Then GoTo lbl_Exit
Set oFSO = CreateObject("Scripting.FileSystemObject")
Do
lng_PS = lng_PathSep
lng_PathSep = InStr(lng_PS + 1, strPath, "\")
If lng_PathSep = 0 Then Exit Do
If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
Loop
Do Until lng_PathSep = 0
If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
oFSO.CreateFolder Left(strPath, lng_PathSep)
End If
lng_PS = lng_PathSep
lng_PathSep = InStr(lng_PS + 1, strPath, "\")
Loop
lbl_Exit:
Set oFSO = Nothing
Exit Sub
End Sub