Word

bugy · #1 10-30-2022, 08:44 AM

Quote:

Originally Posted by BrianHoard

This example displays the numbers for all bookmarks in your document as a msgBox. Since it appears your numbers vary in size, I'm extending the range as long as their are numbers in it. In the code below, you can see the line where your bookmark value from the document is being stored as the var, bookmarkValue.

It was being stored in the previous example as "code", so as Italophile mentioned, you are already storing it as a variable.

Next question for you - What are you going to do with the variable once you have it?
Posting a sample Word document (not screen shots) with the actual bookmarks you're trying to work with, and details about your end goal would be helpful.

This is like a mystery that we're learning a little more with each iteration

Code:

Sub bookmarkValues()
    Dim rng As Range
    Dim bm As Bookmark
    Dim rng_expanded As Range
    Dim bookmarkValue As String
    
    For Each bm In ActiveDocument.Bookmarks
      Set rng = bm.Range
      If rng.Start = rng.End Then
        Set rng_expanded = rng
        rng_expanded.MoveEndWhile cset:="0123456789"
        
        ' Store bookmark document text as a variable
        bookmarkValue = rng_expanded.Text
        
        Call MsgBox(prompt:=("Bookmark value: " & bookmarkValue), buttons:=vbOKOnly)
      End If
    Next bm

End Sub

the bookmar that I want to save in a variable is the one that I attach in the image. It is called "CodiClient".
I want to save the variable because I have a program that saves the document in the directory of that code when I close the document.

I put the code that I have (I want the value that I enter through the inputbox, variable "oBM" to be taken from the bookmark)

Code:

Sub SaveAsBM()
Dim oBM As String
Dim sPath As String
oBM = InputBox("RECEPTE", "ENTRA EL CODI DEL PACIENT", "")
sPath = "C:\Server\" & oBM & "\"
CreateFolders sPath
ActiveDocument.SaveAs sPath & "recepte" & Format(Now, "yyyymmdd hhnnss") & ".pdf"
bFound = True
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

BrianHoard · #2 10-30-2022, 06:39 PM

Okay, I think we're getting closer. I modified your SaveAsBM script as below, replacing the InputBox with code for getting the value of the bookmark named "CodiClient"

It tested fine for me, creating the folder named 11241, and saving the document as a PDF. But the PDF wouldn't open for me, but I trust it's working for you, or you know how to make that part work.

Let me know if this is getting closer to your goal.

Code:

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

Italophile · #3 10-31-2022, 01:25 AM

Looping through the bookmarks collection is unnecessary when there is a built-in function to check that a bookmark exists.

So the simplified code should be:

Code:

Sub SaveAsBM()
    Dim sPath As String: sPath = "C:\Server"
    Dim bmName As String: bmName = "CodiClient"
  
    Dim bm As Bookmark
    Dim bmValue As String
    Dim rng_bm As Range
      
    If ActiveDocument.Bookmarks.Exists(bmName) Then
        Set rng_bm = bm.Range
        If rng_bm.Start = rng_bm.End Then
            rng_bm.MoveEndWhile cset:="0123456789"
            bmValue = rng_bm.Text
        End If
        sPath = (sPath & "\" & bmValue & "\")
        Debug.Print ("Creating folder: " & sPath)
        CreateFolders sPath
        ActiveDocument.SaveAs sPath & "recepte" & Format(Now, "yyyymmdd hhnnss") & ".pdf"
    Else
        Call MsgBox(prompt:=("Unable to find bookmark, " & bmName), buttons:=vbCritical)
    End If

End Sub

bugy · #4 10-31-2022, 11:51 AM

Quote:

Originally Posted by Italophile

Looping through the bookmarks collection is unnecessary when there is a built-in function to check that a bookmark exists.

So the simplified code should be:

Code:

Sub SaveAsBM()
    Dim sPath As String: sPath = "C:\Server"
    Dim bmName As String: bmName = "CodiClient"
  
    Dim bm As Bookmark
    Dim bmValue As String
    Dim rng_bm As Range
      
    If ActiveDocument.Bookmarks.Exists(bmName) Then
        Set rng_bm = bm.Range
        If rng_bm.Start = rng_bm.End Then
            rng_bm.MoveEndWhile cset:="0123456789"
            bmValue = rng_bm.Text
        End If
        sPath = (sPath & "\" & bmValue & "\")
        Debug.Print ("Creating folder: " & sPath)
        CreateFolders sPath
        ActiveDocument.SaveAs sPath & "recepte" & Format(Now, "yyyymmdd hhnnss") & ".pdf"
    Else
        Call MsgBox(prompt:=("Unable to find bookmark, " & bmName), buttons:=vbCritical)
    End If

End Sub

Hello
I get this error, do you know what it could be?
"Object variable or With block variable not set"

Code:

Sub SaveAsBM()
    Dim sPath As String: sPath = "C:\server"
    Dim bmName As String: bmName = "CodiPacient"
  
    Dim bm As Bookmark
    Dim bmValue As String
    Dim rng_bm As Range
      
    If ActiveDocument.Bookmarks.Exists(bmName) Then
        Set rng_bm = bm.Range
        If rng_bm.Start = rng_bm.End Then
            rng_bm.MoveEndWhile cset:="0123456789"
            bmValue = rng_bm.Text
        End If
        sPath = (sPath & "\" & bmValue & "\")
        Debug.Print ("Creating folder: " & sPath)
        CreateFolders sPath
        ActiveDocument.SaveAs sPath & "recepte" & Format(Now, "yyyymmdd hhnnss") & ".pdf"
    Else
        Call MsgBox(prompt:=("Unable to find bookmark, " & bmName), buttons:=vbCritical)
    End If
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

BrianHoard · #5 10-31-2022, 08:47 PM

That error is from "bm.Range" not being valid. That was being used in my original code which was looping through all the bookmarks.
So now, you can use this instead. Notice the difference in how this is setting rng_bm.

Code:

Sub SaveAsBM()
    Dim sPath As String: sPath = "C:\Server"
    Dim bmName As String: bmName = "CodiPacient"
  
    Dim bm As Bookmark
    Dim bmValue As String
    Dim rng_bm As Range
      
    If ActiveDocument.Bookmarks.Exists(bmName) Then
        Set rng_bm = ActiveDocument.Bookmarks(bmName).Range
        If rng_bm.Start = rng_bm.End Then
            rng_bm.MoveEndWhile cset:="0123456789"
            bmValue = rng_bm.Text
        End If
        sPath = (sPath & "\" & bmValue & "\")
        Debug.Print ("Creating folder: " & sPath)
        CreateFolders sPath
        ActiveDocument.SaveAs sPath & "recepte" & Format(Now, "yyyymmdd hhnnss") & ".pdf"
    Else
        Call MsgBox(prompt:=("Unable to find bookmark, " & bmName), buttons:=vbCritical)
    End If
End Sub

bugy · #6 11-02-2022, 10:42 AM

Quote:

Originally Posted by Italophile

Looping through the bookmarks collection is unnecessary when there is a built-in function to check that a bookmark exists.

So the simplified code should be:

Code:

Sub SaveAsBM()
    Dim sPath As String: sPath = "C:\Server"
    Dim bmName As String: bmName = "CodiClient"
  
    Dim bm As Bookmark
    Dim bmValue As String
    Dim rng_bm As Range
      
    If ActiveDocument.Bookmarks.Exists(bmName) Then
        Set rng_bm = bm.Range
        If rng_bm.Start = rng_bm.End Then
            rng_bm.MoveEndWhile cset:="0123456789"
            bmValue = rng_bm.Text
        End If
        sPath = (sPath & "\" & bmValue & "\")
        Debug.Print ("Creating folder: " & sPath)
        CreateFolders sPath
        ActiveDocument.SaveAs sPath & "recepte" & Format(Now, "yyyymmdd hhnnss") & ".pdf"
    Else
        Call MsgBox(prompt:=("Unable to find bookmark, " & bmName), buttons:=vbCritical)
    End If

End Sub

Thank you very much !!! it has worked perfectly for me

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Can I make Word remember the window size and position for each document?	Jennifer Murphy	Word	4	02-20-2023 06:36 PM
Changing Caption Position on Whole Document at once	Alexandarale	Word Tables	1	11-15-2020 06:56 PM
Copy selected text from one document and paste to new document in same position on the page	gasparik	Word VBA	1	05-11-2020 05:41 AM
Starting a document, returning to last position	glennnall	Word	0	10-08-2017 10:09 AM
VBA: how can I know the position on a document?	tinfanide	Excel Programming	3	02-27-2012 03:24 PM