Vba code to save document as pdf using document property text and rename folder.

[staicumihai]

Thanks a lot Gmayor, I tried this, and I got an error

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 (on this line I get the run time error 76 path not found).
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

What am I doing wrong ?