Sub SaveAsBM()
  Dim oBM As String
  Dim sPath As String
  
  Dim bm As Bookmark
  Dim bmName As String
  Dim bmValue As String
  Dim rng_bm As Range
  Dim rng_expanded As Range
  Dim bmCheck As Boolean
  
  bmName = "CodiClient"
  sPath = "C:\Server"
      
  '  oBM = InputBox("RECEPTE", "ENTRA EL CODI DEL PACIENT", "")
  
  ' Store bookmark value for new folder name.
  For Each bm In ActiveDocument.Bookmarks
    If bm.Name = bmName Then
      Set rng_bm = bm.Range
      
      If rng_bm.Start = rng_bm.End Then
        Set rng_expanded = rng_bm
        rng_expanded.MoveEndWhile cset:="0123456789"
        bmValue = rng_expanded.Text
        sPath = (sPath & "\" & bmValue & "\")
        bmCheck = True
      End If
    End If
  Next bm
  
  If bmCheck = True Then
    Debug.Print ("Creating folder: " & sPath)
    CreateFolders sPath
    ActiveDocument.SaveAs sPath & "recepte" & Format(Now, "yyyymmdd hhnnss") & ".pdf"
    bFound = True
  Else
    Call MsgBox(prompt:=("Unable to find bookmark, " & bmName), buttons:=vbCritical)
  End If

End Sub