Bookmark Saver macro

'------------------------------------------------------------------------------
'FILE DESCRIPTION: This macro saves and restores
your precious bookmarks.
'------------------------------------------------------------------------------ 
Dim sFullName, sTitle
Dim nCurLine, nCurCol, nBmkLine, nLastBmkLine
Dim i
Dim bLock, bError, bActive

bLock = False
bActive = True
sTitle = "Bookmark Saver 1.2"

Sub ToggleActive()
    'DESCRIPTION: Switches bookmark saving on or off.
    if (bActive = True) then
    bActive = False
        MsgBox "Bookmark Saver disabled.", vbCritical, sTitle
    else
        bActive = True
        MsgBox "Bookmark Saver enabled.",vbInformation, sTitle
    End If
End Sub

'Bookmarks aus Datei lesen
Sub Application_DocumentOpen(theDoc)
    'Disabled or not a text file?
    if ((bActive = False) Or theDoc.Type <> "Text") then
        Exit Sub
    End If
 
    'Prevent macro from calling itself!
    if (bLock = True) Then
        bLock = False
        Exit Sub
    End If
 
    'Save cursor position
    nCurLine = theDoc.Selection.CurrentLine
    nCurCol = theDoc.Selection.CurrentColumn

    'Get name of bookmark file
    sFullName = theDoc.FullName
    sFullName = sFullName & "_bmk"

    'Check if bookmark file exists
    bLock = True
    On Error Resume Next
    Documents.Open sFullName, "Text"
    if Err.Number <> 0 then
        Exit Sub 'No bmk file found -> exit
    End If
 
    Set sel = ActiveDocument.Selection
 
    'Calculate number of bookmarks
    sel.EndOfDocument dsMove
    nLastBmkLine = sel.CurrentLine - 1

    'Loop through bookmark file, read and set bookmarks
    for i=1 to nLastBmkLine
        sel.GoToLine i
        sel.SelectLine
        nBmkLine = sel.Text
        theDoc.Selection.GoToLine nBmkLine
        theDoc.Selection.SetBookmark
    Next
 
    'Close bookmark file
    bLock = True
    ActiveDocument.Close

    'Restore cursor position
    theDoc.Selection.GoToLine nCurLine + 10
    theDoc.Selection.GoToLine nCurLine
    theDoc.Selection.CharRight dsMove, nCurCol
End Sub
 

'Sub Application_BeforeDocumentClose(theDoc)
'Maybe better for you, test it!
Sub Application_DocumentSave(theDoc)
    'Enabled?
    if ((bActive = False) Or theDoc.Type <> "Text") then
        Exit Sub
    End If

    'Prevent macro from calling itself!
    if (bLock = True) then
        bLock = False
        Exit Sub
    End If

    'Set bookmark file name
    sFullName = theDoc.FullName
    sFullName = sFullName & "_bmk"

    'Set object
    Set sel = theDoc.Selection

    'An error occurs when you have tried to open a nonexisting document
    On Error Resume Next
    if (sel = Null) then
        Exit Sub
    End If

    'Save cursor position
    nCurLine = sel.CurrentLine
    nCurCol = sel.CurrentColumn

    'Go to top of file
    sel.StartOfDocument dsMove
 
    'Check if bookmark file exists
    bLock = True
    On Error Resume Next
    Documents.Open sFullName, "Text"
    if Err.Number <> 0 then
        'If not, make new empty document
        bLock = True
        Documents.Add "Text"
        bError = True
    else
        'If yes, delete contents of old file
        ActiveDocument.Selection.SelectAll
        ActiveDocument.Selection.BackSpace
        bError = False
    End If

    'Search bookmarks
    nLastBmkLine = 0
    Do
        bFound = sel.NextBookmark
        if (bFound = False) then 'No bookmarks found
            if (bError = False) then 'Bookmark file existed, so save empty document
                ActiveDocument.Save sFullName, False
            End If
            bLock = True
            ActiveDocument.Close 'Bookmark file did not exist, just close document
            sel.GoToLine nCurLine
            sel.CharRight dsMove, nCurCol
            Exit Sub
        End If

        nBmkLine = sel.CurrentLine
        if (nBmkLine <= nLastBmkLine) then
            Exit Do
        End If
        nLastBmkLine = nBmkLine
        ActiveDocument.Selection = nBmkLine & vbCRLF 'Write line number to bookmark file
    Loop While (True)

    'Save and close bookmark file
    ActiveDocument.Save sFullName, False
    bLock = True
    ActiveDocument.Close

    'Restore cursor position
    sel.GoToLine nCurLine + 10
    sel.GotoLine nCurLine
    sel.CharRight dsMove, nCurCol
End Sub

Remarks:

• Try out if you want the bookmarks to be saved when you close or when you save your source file. Both has its

advantages and disadvantages (like all things in life).
• Because there is no macro function to delete a file, you should delete your empty *.*_bmk-Files manually from time to time.
• You can't use your Recent Files menu anymore because it is crammed with bookmark list file names :-(
• A bookmark in the first line of the document will not be saved.