Sub SaveAsBM()

'Graham Mayor - https://www.gmayor.com - Last updated - 09 Mar 2022 

Dim oBM As Bookmark
Dim sPath As String
Dim bFound As Boolean
    For Each oBM In ActiveDocument.Bookmarks
        If LCase(oBM.Name) = "code" Then
            If IsNumeric(oBM.Range.Text) = True Then
                sPath = "C:\Server\" & oBM.Range.Text & "\"
                CreateFolders sPath
                ActiveDocument.SaveAs sPath & "filename.docx" 'change filename as required
                bFound = True
            Else
                MsgBox "Bookmark content is not numeric", vbCritical
                GoTo lbl_Exit
            End If
            Exit For
        End If
    Next oBM
    If Not bFound = True Then
        MsgBox "Bookmark not present", vbCritical
    End If
lbl_Exit:
    Set oBM = Nothing
    Exit Sub
End Sub

Private Function CreateFolders(strPath As String)
Dim strTempPath As String
Dim lng_Path As Long
Dim VPath As Variant
Dim oFSO As Object
Dim i As Integer
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    VPath = Split(strPath, "\")
    If Left(strPath, 2) = "\\" Then
        strPath = "\\" & VPath(2) & "\"
        For lng_Path = 3 To UBound(VPath)
            strPath = strPath & VPath(lng_Path) & "\"
            If Not oFSO.FolderExists(strPath) Then MkDir strPath
        Next lng_Path
    Else
        strPath = VPath(0) & "\"
        For lng_Path = 1 To UBound(VPath)
            strPath = strPath & VPath(lng_Path) & "\"
            If Not oFSO.FolderExists(strPath) Then MkDir strPath
        Next lng_Path
    End If
lbl_Exit:
    Set oFSO = Nothing
    Exit Function
End Function