Sub SaveAsBM()
Dim oBM As Bookmark
Dim sPath As String
Dim bFound As Boolean
    For Each oBM In ActiveDocument.Bookmarks
        If LCase(oBM.Name) = "CodiPacient" Then
            If IsNumeric(oBM.Range.Text) = True Then
                sPath = "C:\Proves\" & oBM.Range.Text & "\"
                CreateFolders sPath
                ActiveDocument.SaveAs sPath & "recepte.doc" '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
End Function
Sub TestBookmark()
  Dim oBM As Bookmark
  If ActiveDocument.Bookmarks.Exists("CodiPacient") Then
    Set oBM = ActiveDocument.Bookmarks("CodiPacient")
    MsgBox oBM.Range.Text
  Else
    MsgBox "This bookmark doesn't exist" & vbCr & "CodiPacient"
  End If
End Sub