Etudes for Microsoft Word Programmers

Home ] Up ]


 

Etude 4.1. Document State Saver

Resources

Template "AhDocStateSaver.dot", 68 , ZIP [download].

"Microsoft Office Extensions" Contest



 

Program "AhDocStateSaver" took part in the "Microsoft Office Extensions" contest (see http://www.offext.ru), which is held by PC Magazine (Russian Edition) and Microsoft.

Program was tested and has received "Yes, it Works!" logo.

"AhDocStateSaver" page on "Microsoft Office Extensions" web site.

 

 

 

Functional Specification

Task

Microsoft Word always sets the caret at the beginning of the open document. This is wrong and extremely inconvenient when you work with large documents. Documents should be opened in the same state in which they have been closed.

The task is to create the global template "AhDocStateSaver.dot" using Microsoft Word event handlers. The template should save the document state when the document is closed and restore the previously saved state when the document is opened,

Apart from the caret position, the template should save and restore the following document properties:

Setting

Description

SelBeg, SelEnd

Selection position

Zoom

Zoom factor

VScroll

Vertical scrolling position

View

View (Normal, Web, Print, Reading, Outline)

Settings

All Program (template "AhDocStateSaver.dot") settings are stored in XML file "AhDocStateSaver.xml", which is located in the same folder as the Program itself.

The "settings" node "language" attribute defines the UI language ("eng" English, "rus" - Russian). Any XML editor could be used for editing the "AhDocStateSaver.xml" file.

The "AhDocStateSaver.xml" file looks like this:

<documents>

<settings language="rus"/>

<document Path="__Default_|_Document_|_State__" View="3" VScroll="0" Zoom="100" SelBeg="669" SelEnd="674"/>
<document Path="D:\_Ah\AhDocStateSaver.doc" View="3" VScroll="0" Zoom="111" SelBeg="829" SelEnd="850"/>
<document Path="D:\_Ah\AhDocStateSaver.dot" View="3" VScroll="40" Zoom="100" SelBeg="883" SelEnd="883"/>
</documents>

The special value of the attribute Path = "__Default_|_Document_|_State__" is used for saving the default document state which is used for all new documents.

Toolbar "AhDocStateSaver"

Generally speaking, the main template functionality does not require any user's activity. When a document is closed the Program saves its state automatically, and when the document is then opened the Program restores the saved state. Thats all.

The access to the optional Program functions is given by the AhDocStateSaver toolbar.
The "AhDocStateSaver" toolbar looks like this

and provides the following (optional) functions

Button

Macro

Description

AhDocStateSaverHelp

Help. Program version information.

AhDocStateSaverSwitch

Switching Program off. After switching the icon is changed to .

AhDocStateSaverSwitch

Switching Program on. After switching the icon is changed to .

AhDocStateSaverDialog

The "Documents" dialog is intended for fast document open and allows user to delete files that are not used. The dialog could be used instead of MRU list (Most Recent Used documents list in the "File" menu) and could hold an unlimited number of documents.

Help

The help box and version information looks like this:

Dialog "Documents"

The "Documents" Dialog looks like this:

To open the document just select the document from the list and press the "Open" button. Or just double click the required document in the list.

To delete the document just select the document from the list and press the "Delete" button. After deletion press "OK" button to save changes or press "Cancel" button to discard changes.

Implementation - Template "AhDocStateSaver.dot"

The template consists of three class modules - AhDocData (document state), AhDocColl (collection of AhDocData), AhDocStateSaverWordApp (event handlers), one form module AhDocStateSaverDocumentsForm and one main module AhDocStateSaver that agglutinates all functionalities together.

Class Module AhDocData - document state

The AhDocData class provides data structure which is responsible for the document state. Apart from constructor and destructor it contains two more procedures. The procedure ( ) SetDocData fills data structure with document data, and the procedure ApplyTo applies the saved data to the document. The Dump procedure is optional and is used for debugging.

'
' File AhDocStateSaver.dot|AhDocData
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Data members
'
Public strFullName As String
Public iView As Long
Public iSelBeg As Long
Public iSelFin As Long
Public iVScr As Long
Public iZoom As Long
'
' Constructor
'
Private Sub Class_Initialize()
    strFullName = ""
    iView = wdPrintView ' wdNormalView 
    iSelBeg = 0
    iSelFin = 0
    iVScr = 0
    iZoom = 100
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
End Sub
'
' SetDocData
'
Public Sub SetDocData(aDoc As Document)
    strFullName = aDoc.FullName
   
    With Selection
        iSelBeg = .Range.Start
        iSelFin = .Range.End
    End With
   
    With aDoc.ActiveWindow
        iView = .view.Type
        iZoom = .view.Zoom.Percentage
        iVScr = .VerticalPercentScrolled
    End With
End Sub
'
' ApplyTo
'
Public Sub ApplyTo(aDoc As Document, Optional ByVal bApplyRange As Boolean = True)
    Debug.Print "ApplyTo <" & aDoc.FullName & ">."
    With aDoc.ActiveWindow
        .view.Type = iView
        .view.Zoom.Percentage = iZoom
        .VerticalPercentScrolled = iVScr
    End With

    If bApplyRange Then
        Dim aRange As Range
        Set aRange = Selection.Range
        aRange.Start = iSelBeg
        aRange.End = iSelFin
        aRange.Select
    End If
End Sub
'
' Dump
'
Sub Dump()
    Debug.Print "   sPath = <" & strFullName & ">."
    Debug.Print "   iView = " & iView
    Debug.Print "   iZoom = " & iZoom
    Debug.Print "   iVScr = " & iVScr
    Debug.Print "   iSelBeg = " & iSelBeg
   
Debug.Print "   iSelFin = " & iSelFin
End Sub

Class Module AhDocColl - collection of AhDocData

The AhDocColl class is a wrapper/cover on the collection of AhDocData elements. Function Register adds an element to the collection, and function Unregister deletes the element from the collection. Functions FindIndex4FilePath and FindIndexOf are used for searching an element in the collection. Functions Load and Save are intended to exchange data between the collection and XML file.

'
' File AhDocStateSaver.dot|AhDocColl
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Data members
'
Private docs As Collection
'
' XML File
'
Const MSXML = "Msxml2.DOMDocument.3.0"
Private Const cStrParFileName As String = "AhDocStateSaver.xml"
Private Const cStrErrSaveText As String = "Error saving documents collection to XML file <%1>."
Private Const cStrErrLoadText As String = "Error loading documents collection from XML file <%1>."
'
' XML 'Root' node attributes
'
Private Const cStrParRoot As String = "documents"
Private Const cStrParNode As String = "document"
'
' settings
'
Private Const cStrParSett As String = "settings"
Private Const cStrParLang As String = "language"
'
' XML 'Document' node attributes
'
Private Const cStrParPath As String = "Path"
Private Const cStrParSBeg As String = "SelBeg"
Private Const cStrParSEnd As String = "SelEnd"
Private Const cStrParView As String = "View"
Private Const cStrParVscr As String = "VScroll"
Private Const cStrParZoom As String = "Zoom"
'
'
'
Private Const cStrRegTextNotFound As String = "Register [%1]. Not Found. Added."
Private Const cStrRegTextFound As String = "Register [%1]. Found."

Private Const cStrUnRegTextFound As String = "Unregister [%1]. Found and Deleted."
Private Const cStrUnRegTextNotFound As String = "Unregister [%1]. NOT FOUND."
'
' Constructor
'
Private Sub Class_Initialize()
    Set docs = New Collection
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
    Set docs = Nothing
End Sub
'
' Register
'
Public Function Register(aDoc As Document) As Boolean
Dim dd As AhDocData
    For Each dd In docs
        ' If aDoc Is docs(iItem).doc Then   ' WRONG! Use 'Is' instead of '=; for objects.
        ' If aDoc Is dd.doc Then
        If LCase(dd.strFullName) = LCase(aDoc.FullName) Then
            '
            ' found
            '
            dd.SetDocData aDoc
            Debug.Print Replace(cStrRegTextFound, "%1", aDoc.Name)
            Register = True  ' means found and doc data was changed
            Exit Function
        End If
    Next dd
    '
    ' not found - create new item
    '
    Dim aNewDocData As New AhDocData
    aNewDocData.SetDocData aDoc
    '
    ' Add item to the collection
    '
    docs.Add aNewDocData
    Debug.Print Replace(cStrRegTextNotFound, "%1", aDoc.Name)
    Register = False ' means not found and new object was created
End Function
'
' Unregister
'
Public Function Unregister(aDoc As Document) As Boolean
    Dim iItem As Long
    For iItem = 1 To docs.Count
        ' If aDoc Is docs(iItem).doc Then
        If LCase(docs(iItem).Doc.FullName) = LCase(aDoc.FullName) Then
            '
            ' found
            '
            Debug.Print Replace(cStrUnRegTextFound, "%1", aDoc.Name)
            docs.Remove (iItem)
            Unregister = True    ' means found and removed
            Exit Function
        End If
    Next iItem
    '
    ' not found
    '
    Debug.Print Replace(cStrUnRegTextNotFound, "%1", aDoc.Name)
    Unregister = False ' means not found
End Function
'
' FindIndexOf
'
Public Function FindIndexOf(aDoc As Document) As Long
    FindIndexOf = FindIndex4FilePath(aDoc.FullName)
End Function
'
' FindIndex4FilePath
'
Public Function FindIndex4FilePath(ByVal strFilePath As String) As Long
    Dim strfilename As String
    strfilename = LCase(strFilePath)
    Dim strFileItem As String
   
    Dim iItem As Long
    For iItem = 1 To docs.Count
        strFileItem = docs(iItem).strFullName
        ' Debug.Print iItem & "/. " & strfileitem
        If LCase(strFileItem) = strfilename Then
            '
            ' found
            '
            FindIndex4FilePath = iItem
            Exit Function
        End If
    Next iItem
    '
    ' not found
    '
    FindIndex4FilePath = ciNotFound
End Function
'
' GetSize
'
Public Function GetSize() As Long
    GetSize = docs.Count
End Function
'
' GetDocName
'
Public Function GetDocName(ByVal iItem As Long) As String
    GetDocName = docs(iItem).strFullName
End Function
'
' DeleteItem
'
Sub DeleteItem(ByVal iItem As Long)
    docs.Remove iItem
End Sub
'
' Dump
'
Sub Dump(ByVal strTitle As String)
    Dim nItems As Long
    nItems = docs.Count
    Debug.Print "AhDocColl Dump +++ Items = " & nItems & "<--- " & strTitle
    Dim iItem As Long
    For iItem = 1 To nItems
        Debug.Print "  " & CStr(iItem) & "/. [" & docs(iItem).strFullName
        docs(iItem).Dump
    Next iItem
    Debug.Print "AhDocColl Dump ==="
End Sub
'
' ApplyTo
'
Public Sub ApplyTo(ByVal ind As Long, aDoc As Document)
    docs(ind).ApplyTo aDoc
End Sub
'
' AhXMLInit
'
Private Function AhXMLInit(ByRef xmldoc, ByVal xmlFilePath As String, ByVal strErrMess As String) As Boolean
 strErrMess = ""
 
 On Error Resume Next
 Set xmldoc = CreateObject(MSXML)
 xmldoc.async = False
 xmldoc.resolveExternals = False
 xmldoc.validateOnParse = False
 xmldoc.preserveWhiteSpace = True
 
 If Len(xmlFilePath) > 0 Then
    '
    ' load XML file
    '
    xmldoc.Load xmlFilePath
 
    If (Err.Number = 0) Then
        AhXMLInit = True
    Else
        AhXMLInit = False
        strErrMess = "File <" & xmlFilePath & "> load error [" & xmldoc.parseError.errorCode & "]."
    End If
 
 Else
    ' do not load
    AhXMLInit = True
 End If
 End Function
'
' AhGetXMLPath
'
Private Function AhGetXMLPath() As String
    AhGetXMLPath = Application.StartupPath + "\" + cStrParFileName
End Function
'
' AhXMLCreateSett
'
Private Sub AhXMLCreateSett(ByRef xmldoc, ByRef xmlroot)
    '
    ' settings
    '
    Dim e
    Set e = xmldoc.createElement(cStrParSett)
       
    e.setAttribute cStrParLang, AhGetLanguageAsString
    ' e.setAttribute cStrParXXX, XXX
    xmlroot.appendChild e
    '
    ' space
    '
    Dim s
    Set s = xmldoc.createTextNode(vbCrLf)
    xmlroot.appendChild s
   
End Sub

'
' AhXMLCreateNode
'
Private Sub AhXMLCreateNode(ByRef xmldoc, ByRef xmlroot, ByRef dd As AhDocData)
    '
    ' document
    '
    Dim e
    Set e = xmldoc.createElement(cStrParNode)
       
    e.setAttribute cStrParPath, dd.strFullName
    e.setAttribute cStrParView, dd.iView
    e.setAttribute cStrParVscr, dd.iVScr
    e.setAttribute cStrParZoom, dd.iZoom
    e.setAttribute cStrParSBeg, dd.iSelBeg
    e.setAttribute cStrParSEnd, dd.iSelFin
    xmlroot.appendChild e
       
    '
    ' space
    '
    Dim s
    Set s = xmldoc.createTextNode(vbCrLf)
    xmlroot.appendChild s
End Sub
'
' Save
'
Public Sub Save()
    On Error GoTo ErrorLabel
    Debug.Print "AhDocColl::Save"
    Dim strErrMess As String
    Dim filePath As String
    filePath = AhGetXMLPath
   
    '
    ' xml
    '
    Dim xmldoc
    If Not AhXMLInit(xmldoc, "", strErrMess) Then
        MsgBox strErrMess
        Exit Sub
    End If
   
    '
    ' root
    '
    Dim xmlroot
    Set xmlroot = xmldoc.createElement(cStrParRoot)
    xmldoc.appendChild xmlroot
       
    Dim space
    Set space = xmldoc.createTextNode(vbCrLf)
    xmlroot.appendChild space
   
    '
    ' default doc state (special file path is used)
    '
    DocDataDflt.strFullName = cStrDefDocStateName
    AhXMLCreateNode xmldoc, xmlroot, DocDataDflt
    '
    ' <document> nodes
    '
    Dim iItem As Long
    For iItem = 1 To docs.Count
        AhXMLCreateNode xmldoc, xmlroot, docs(iItem)
    Next iItem
   
    '
    ' <settings>
    '
    AhXMLCreateSett xmldoc, xmlroot
   
    xmldoc.Save filePath
    Exit Sub
   
ErrorLabel:
    MsgBox Replace(cStrErrSaveText, "%1", filePath)
End Sub
'
' AhXmlNode2Long
'
Private Function AhXmlNode2Long(ByVal xmlNodes As Variant, ByVal iNode As Long, ByVal cStrAttrName As String, ByVal iDefault As Long) As Long
    Dim x
    x = xmlNodes(iNode).getAttribute(cStrAttrName)
    ' If (x <> Null) And (x <> "") Then
    Debug.Print "Node " & CStr(iNode) & ". Attr = <" & cStrAttrName & "> is <" & x & ">."
    If x <> "" Then
        On Error Resume Next
        AhXmlNode2Long = CLng(x)
    Else
        ' do nothing but report
        Debug.Print "   *** is Empty."
        AhXmlNode2Long = iDefault
    End If
End Function
'
' Load
'
Public Sub Load()
    Debug.Print "AhDocColl::Load"
    Dim strErrMess As String
    Dim filePath As String
    filePath = AhGetXMLPath
   
    Dim xmldoc
    If Not AhXMLInit(xmldoc, filePath, strErrMess) Then
        MsgBox strErrMess
        Exit Sub
    End If
   
    On Error GoTo ErrorLabel
    Dim bFileExists As Boolean
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
   
    Dim xPath As String
    xPath = "//" + cStrParRoot + "/" + cStrParNode
    Dim n, nNodes
    Dim xmlNodes
    If xmldoc.documentElement Is Nothing Then
        nNodes = 0
    Else
        Set xmlNodes = xmldoc.documentElement.SelectNodes(xPath)
        nNodes = xmlNodes.Length
    End If
   
   
    ' MsgBox "nNodes = " & nNodes
    Dim strPath As String
    Dim dd As AhDocData
    For n = 0 To nNodes - 1
        strPath = xmlNodes(n).getAttribute(cStrParPath)
        Debug.Print (n + 1) & "/. name = <" & strPath & ">."
        '
        ' We don't validate xml data integrity here.
        ' Check file existence only.
        If (strPath <> "") Then
            Set dd = New AhDocData
            '
            ' doc path
            '
            dd.strFullName = strPath
            '
            ' other attributes
            '
            dd.iView = AhXmlNode2Long(xmlNodes, n, cStrParView, dd.iView)
            dd.iVScr = AhXmlNode2Long(xmlNodes, n, cStrParVscr, dd.iVScr)
            dd.iZoom = AhXmlNode2Long(xmlNodes, n, cStrParZoom, dd.iZoom)
            dd.iSelBeg = AhXmlNode2Long(xmlNodes, n, cStrParSBeg, dd.iSelBeg)
            dd.iSelFin = AhXmlNode2Long(xmlNodes, n, cStrParSEnd, dd.iSelFin)
           
            bFileExists = fs.FileExists(strPath)
            If bFileExists Then
                '
                ' add new element to the collection
                '
                docs.Add dd
            ElseIf (strPath = cStrDefDocStateName) Then
                DocDataDflt.strFullName = cStrDefDocStateName
                DocDataDflt.iView = dd.iView
                DocDataDflt.iVScr = dd.iVScr
                DocDataDflt.iZoom = dd.iZoom
                DocDataDflt.iSelBeg = dd.iSelBeg
                DocDataDflt.iSelFin = dd.iSelFin
            End If
            Set dd = Nothing
        Else
            ' ignore node with empty path
        End If
    Next n
   
    Set fs = Nothing
   
    '
    ' settings
    '
    xPath = "//" + cStrParRoot + "/" + cStrParSett
    If xmldoc.documentElement Is Nothing Then
    Else
        Set xmlNodes = xmldoc.documentElement.SelectNodes(xPath)
        nNodes = xmlNodes.Length
        If nNodes > 0 Then
            Dim strPar As String
            strPar = xmlNodes(0).getAttribute(cStrParLang)
            lang_ = AhGetLanguage(strPar)
            Debug.Print "Language = " & lang_
        End If
    End If
   
    Dump "--- After Load ---"
    Exit Sub
   
ErrorLabel:
    Set fs = Nothing
    MsgBox Replace(cStrErrLoadText, "%1", filePath)
End Sub

Class Module AhDocStateSaverWordApp - event handlers

Class module AhDocStateSaverWordApp contains Microsoft Word event handlers. The class contains a reference to the Word.Application object, and its WithEvents declaration allows module functions to intercept Microsoft Word events. The reference to the Word.Application object is set and released in the main template module on startup and exit respectively.

The module intercepts the following events - DocumentBeforeClose, DocumentOpen and NewDocument. When a document is closed the document state is saved in the collection. When a document is then opened its state is restored. If an unknown document is opened or a new document is created the default document state is applied.

'
' File AhDocStateSaver.dot|AhDocStateSaverWordApp
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Word Application Object (With Events)
'
Public WithEvents obj As Word.Application
'
' Note, that event handlers below should be named as obj_XXX to really catch events.
'
'
' Constructor
'
Private Sub Class_Initialize()
End Sub
'
' Destructor
'
Private Sub Class_Terminate()
End Sub
'
' DocumentBeforeClose
'
Private Sub obj_DocumentBeforeClose(ByVal Doc As Document, Cancel As Boolean)
    Debug.Print "DocumentBeforeClose " & Doc.Name
    AhDocStateSaverRegDoc Doc
End Sub
'
' DocumentOpen
'
Private Sub obj_DocumentOpen(ByVal Doc As Document)
    Debug.Print "DocumentOpen " & Doc.Name
    AhDocStateSaverOpenDoc Doc
End Sub

Private Sub obj_NewDocument(ByVal Doc As Document)
    AhDocStateSaverNewDoc Doc
End Sub

'
' Quit
'
Private Sub obj_Quit()
   
AhDocStateSaverExit
End Sub

Form Module AhDocStateSaverDocumentsForm

The form AhDocStateSaverDocumentsForm provides a user interface and some functions for working with the saved collection. Any saved document could be opened for editing or could be deleted from the collection. The form deals with the collection copy, therefore the user should press the "OK" button to save changes or press the "Cancel" button to discard changes.

'
' File AhDocStateSaver.dot|AhDocStateSaverDocumentsForm
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' Dialog data
'
Public dwDialogResult As Long
Public dwSelectedItem As Long

Private DocsCollCopy As AhDocColl
'
' Constructor
'
Private Sub UserForm_Initialize()
    dwDialogResult = vbCancel
    Set DocsCollCopy = DocsColl
End Sub
'
' Destructor
'
Private Sub UserForm_Terminate()
    Set DocsCollCopy = Nothing
End Sub
'
' InitDialogData
'
Public Sub InitDialogData()
    '
    ' ListBox
    '
    Dim k As Long
    Dim dwSize As Long
    dwSize = DocsCollCopy.GetSize
    For k = 1 To dwSize
        ListBox1.AddItem DocsCollCopy.GetDocName(k)
    Next k

    ListBox1.ColumnHeads = False
    ListBox1.MultiSelect = fmMultiSelectSingle
   
    '
    ' Enable Controls
    '
    If 0 = ListBox1.ListCount Then
        btnDelete.Enabled = False
        btnOK.Enabled = False
        btnOpen.Enabled = False
    Else
        ListBox1.Selected(0) = True
    End If
   
    If lang_ = langEng Then
    Me.Caption = "AhDocStateSaver - Documents"
    ' delete
    btnDelete.Caption = "Delete"
    btnDelete.ControlTipText = "Delete selected document from the list"
    ' open
    btnOpen.Caption = "Open"
    btnOpen.ControlTipText = "Open selected document"
    ' cancel
    btnCancel.Caption = "Cancel"
    btnCancel.ControlTipText = "Close form discarding changes"
    ' OK
    btnOK.ControlTipText = "Close form saving changes"
   
    SaveItSelf
    End If
   
End Sub
'
' Delete
'
Private Sub btnDelete_Click()
    If 0 = ListBox1.ListCount Then Exit Sub
    Dim dwSelectedItem As Long
    dwSelectedItem = ListBox1.ListIndex
    ' delete item from the collection
    ' Ah! 13-Mar-2008. Bug fixed - note this (+1) below.
    DocsCollCopy.DeleteItem dwSelectedItem
+ 1
   
    ' remove list control item
    ListBox1.RemoveItem dwSelectedItem
End Sub
'
' DblClick on List
'
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    btnOpen_Click
End Sub
'
' UnloadForm
'
Private Sub UnloadForm()
    Set DocsCollCopy = Nothing
    Unload Me
End Sub
'
' Open
'
Private Sub btnOpen_Click()
    If 0 = ListBox1.ListCount Then Exit Sub
    Dim dwSelectedItem As Long
    dwSelectedItem = ListBox1.ListIndex + 1
    Dim strDocPath As String
    strDocPath = DocsCollCopy.GetDocName(dwSelectedItem)
   
    On Error GoTo ErrorLabel
    Documents.Open strDocPath
   
   
'
    ' Open does,'t save changes.
    '
    UnloadForm
    Exit Sub
ErrorLabel:
    '
    ' report error
    '
    Dim cStrDocCannotOpenFile As String
    If lang_ = langEng Then
        cStrDocCannotOpenFile = "Cannot open file <%1>."
    Else
        cStrDocCannotOpenFile = "Îøèáêà îòêðûòèÿ ôàéëà <%1>."
    End If
    MsgBox Replace(cStrDocCannotOpenFile, "%1", strDocPath)
End Sub
'
' Cancel
'
Private Sub btnCancel_Click()
    dwDialogResult = vbCancel
    UnloadForm
End Sub
'
' OK
'
Private Sub btnOK_Click()
    ' dwSelectedItem = ListBox1.ListIndex
    dwDialogResult = vbOK
    Set DocsColl = DocsCollCopy
    UnloadForm
End Sub

Main Module AhDocStateSaver - agglutinant

AhDocStateSaver is the main template module that agglutinates all functions together. Automacros are used for automatic template initialization. The procedure AhDocStateSaverInit switches the plugin on on startup (or when the "Switch On" button is pressed), and the procedure AhDocStateSaverExit switches the plugin off on exit (or when the "Switch Off" button is pressed). Both procedures are used in the procedure AhDocStateSaverSwitch, which switches the plugin state on and off. The procedure AhDocStateSaverDialog shows the "Documents" dialog. The procedures AhDocStateSaverRegDoc, AhDocStateSaverNewDoc and AhDocStateSaverOpenDoc are event handlers.

'
' File AhDocStateSaver.dot|AhDocStateSaver
'
' Etudes for Microsoft Word Programmers.
' Etude 4.1. Document State Saver.
'
' First published on http://www.transcriber.ru
'
' 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide.
'
Option Explicit
'
' MS Word Object
'
Dim WordObject As New AhDocStateSaverWordApp
'
' Documents Collection
'
Public DocsColl As AhDocColl
'
' Default DocData Object
'
Public DocDataDflt As AhDocData
'
' Common Constants
'
Public Const ciNotFound As Long = -1

Public Const langEng As Long = 0
Public Const langRus As Long = 1
Public lang_ As Long

'
' Debug Strings are in Enlish
'
Private Const cStrDocFound As String = "Document <%1> found in the Collection!"
Private Const cStrDocNotFound As String = "Document <%1> NOT FOUND in the Collection!"
Private Const cStrWordCreated As String = "Word Object created."
Private Const cStrWordDestroyed As String = "Word Object destroyed."
Private Const cStrCollCreated As String = "Documents Collection created and loaded."
Private Const cStrCollSavedAndDestroyed As String = "Documents Collection saved and destroyed."
Private Const cStrThisTemplateName As String = "AhDocStateSaver.dot"
Private Const cStrToolbarName As String = "AhDocStateSaver"
'
Public Const cStrDefDocStateName As String = "__Default_|_Document_|_State__"
'
Private Const cbOnDialogPressedInitPlugin As Boolean = True

'
' AhDocStateSaverHelp
'
Sub AhDocStateSaverHelp()
Dim strState As String
If lang_ = langEng Then
    strState = "Document State Saver is "
    If WordObject.obj Is Nothing Then
        strState = strState + "not "
    End If
    strState = strState + "activated."

    MsgBox "Etudes for Microsoft Word Programmers." & vbCrLf & vbCrLf & _
        "Etude 4.1. Document State Saver." & vbCrLf & _
        " 2007-2008. Evgeny Akhundzhanov. All rights reserved worldwide." & vbCrLf & _
        "http://www.transcriber.ru" & vbCrLf & vbCrLf & _
        "Template 'AhDocStateSaver.dot' - saves document state on close " & _
        "and restores on open." & vbCrLf & vbCrLf & _
        strState & vbCrLf & vbCrLf & _
        "Special version for 'Microsoft Office Extensions' contest."
Else
    ' assume russian
    strState = "
  "
    If WordObject.obj Is Nothing Then
        strState = strState + "
."
    Else
        strState = strState + "
."
    End If

    MsgBox "
Microsoft Word." & vbCrLf & vbCrLf & _
        "
4.1. AhDocStateSaver - ." & vbCrLf & _
        "
'Microsoft Office Extensions'." & vbCrLf & vbCrLf & _
        " 2007-2008. . . " & _
        "http://www.transcriber.ru" & vbCrLf & vbCrLf & _
        " 'AhDocStateSaver.dot' - " & _
        " ."
& vbCrLf & vbCrLf & _
        strState & vbCrLf & vbCrLf
End If
End Sub
'
' AutoExec
'
Sub AutoExec()
    Debug.Print "AutoExec"
    AhDocStateSaverInit
End Sub
'
' AutoOpen
'
Sub AutoOpen()
    Debug.Print "AutoOpen"
    AhDocStateSaverInit
End Sub
'
' AutoClose
'
Sub AutoClose()
    Debug.Print "AutoClose"
End Sub
'
' AutoExit
'
Sub AutoExit()
    Debug.Print "AutoExit"
    AhDocStateSaverExit
End Sub
'
' AhDocStateSaverInit
'
Sub AhDocStateSaverInit()
    lang_ = langRus ' default language
    Debug.Print "AhDocStateSaverInit +++"
    '
    ' create word application ref. object
    '
    If WordObject.obj Is Nothing Then
        Set WordObject.obj = Word.Application
        Debug.Print cStrWordCreated
    End If
   
    '
    ' create documents collection object
    '
    If DocsColl Is Nothing Then
        Set DocDataDflt = New AhDocData
        Set DocsColl = New AhDocColl
        DocsColl.Load
        Debug.Print cStrCollCreated
    End If
    Debug.Print "AhDocStateSaverInit ==="
    AhDocStateSaverState
End Sub
'
' AhDocStateSaverExit
'
Sub AhDocStateSaverExit()
    Debug.Print "AhDocStateSaverExit +++"
    '
    ' save and destroy documents collection object
    '
    If Not DocsColl Is Nothing Then
        DocsColl.Save
        Set DocsColl = Nothing
        Set DocDataDflt = Nothing
        Debug.Print cStrCollSavedAndDestroyed
    End If
   
    '
    ' destroy word application ref. object
    '
    If Not WordObject.obj Is Nothing Then
        Set WordObject.obj = Nothing
        Debug.Print cStrWordDestroyed
    End If

    Debug.Print "AhDocStateSaverExit ==="
    AhDocStateSaverState
End Sub
'
' AhDocStateSaverDump
'
Sub AhDocStateSaverDump()
    If Not DocsColl Is Nothing Then
        DocsColl.Dump "AhDocStateSaverDump"
    Else
        Debug.Print "AhDocStateSaverDump: DocsColl Is Nothing"
    End If
End Sub
'
' AhDocStateSaverState
'
Sub AhDocStateSaverState()
    Dim dwFaceId As Long
    Dim dwState As Long
    Dim strState As String
    If WordObject.obj Is Nothing Then
        strState = "AhDocStateSaver is not activated."
        dwFaceId = 9030
        dwState = msoButtonUp
    Else
        strState = "AhDocStateSaver is activated."
        dwFaceId = 9029
        dwState = msoButtonDown
    End If

    Dim ctrl As CommandBarControl
    For Each ctrl In CommandBars(cStrToolbarName).Controls
        If ctrl.OnAction = "AhDocStateSaver.AhDocStateSaverSwitch" Then
            ctrl.State = dwState
            ctrl.FaceId = dwFaceId
            ctrl.Caption = ctrl.Caption + " "   ' force change
            ctrl.Caption = strState
            SaveItSelf
            Exit For
        End If
    Next ctrl
End Sub
'
' SaveItSelf - makes template with name cStrThisTemplateName "Saved".
'
Public Sub SaveItSelf()
    Dim tt As Template
    For Each tt In Templates
        If LCase(tt.Name) = LCase(cStrThisTemplateName) Then
            tt.Saved = True
        End If
    Next tt
   
    ' Ah! 12-Apr-2007. Attached templates 'Save MsgBox' problem fixed.
    If Documents.Count > 0 Then
        On Error Resume Next
        ActiveDocument.AttachedTemplate.Saved = True
    End If
End Sub
'
' AhGetLanguage
'
Public Function AhGetLanguage(strLang As String) As Long
    AhGetLanguage = langRus ' default
    If Len(strLang) > 0 Then
        If (strLang = "english") Or (strLang = "eng") Or (strLang = "0") Then
            AhGetLanguage = langEng
        End If
    End If
End Function
'
' AhGetLanguageAsString
'
Public Function AhGetLanguageAsString() As String
    If lang_ = langEng Then
        AhGetLanguageAsString = "eng"
    Else
        AhGetLanguageAsString = "rus"
    End If
End Function
'
' AhDocStateSaverSwitch
'
Sub AhDocStateSaverSwitch()
    If WordObject.obj Is Nothing Then
        AhDocStateSaverInit
    Else
        AhDocStateSaverExit
    End If
End Sub
'
' AhDocStateSaverDialog
'
Sub AhDocStateSaverDialog()
    If WordObject.obj Is Nothing Then
        If cbOnDialogPressedInitPlugin Then
            AhDocStateSaverInit
        Else
            Exit Sub
        End If
    End If
    Dim dlg As AhDocStateSaverDocumentsForm
    Set dlg = New AhDocStateSaverDocumentsForm
    With dlg
        .InitDialogData
        .Show vbModal
        If dlg.dwDialogResult = vbOK Then
            ' do something terrible
        End If
        ' SaveItSelf
    End With
    Set dlg = Nothing
End Sub
'
' AhDocStateSaverRegDoc
'
Sub AhDocStateSaverRegDoc(aDoc As Document)
    ' assume this is called when document is closed
    ' add only documents with existing files
    Dim sFilePath As String
    sFilePath = aDoc.FullName
    Dim bExists As Boolean
    Dim fs
    Set fs = CreateObject("Scripting.FileSystemObject")
    bExists = fs.FileExists(sFilePath)
    Debug.Print "File <" & sFilePath & "> exists = " & bExists
    If bExists Then
        DocsColl.Register aDoc
    End If
    Set fs = Nothing
End Sub
'
' AhDocStateSaverNewDoc
'
Sub AhDocStateSaverNewDoc(aDoc As Document)
    ' apply default state to the new document
    DocDataDflt.ApplyTo aDoc, False
End Sub
'
' AhDocStateSaverOpenDoc
'
Sub AhDocStateSaverOpenDoc(aDoc As Document)
    ' assume this is called when document is opened
    Dim ind As Long
    ind = DocsColl.FindIndex4FilePath(aDoc.FullName)
    If ciNotFound = ind Then
        Debug.Print Replace(cStrDocNotFound, "%1", aDoc.FullName)
    Else
        Debug.Print Replace(cStrDocFound, "%1", aDoc.FullName)
        DocsColl.ApplyTo ind, aDoc
    End If
End Sub

 

Conslusions

The global template "AhDocStateSaver.dot" is created on the basis of specification in this etude. The template saves a document state when the document is closed and then restores the saved state when the document is opened. As all the job is done automatically by event handlers in the background mode, the toolbar is optional and could be invisible.

Creating Plugin - Step by Step

This template was created in five steps. All steps were saved [217 Kb, ZIP, download].

"AhDocStateSaver-1.dot" - skeleton.
"AhDocStateSaver-2.dot"  - documents collection in memory.
"AhDocStateSaver-3.dot" switch on/off button, "Documents" form. XML file.
"AhDocStateSaver-4.dot" default document state.
"AhDocStateSaver-5.dot" the final version of the template.

 

Simultaneous copying of some versions of the same plugin to the startup folder does not seem a good idea. Copy each version of the plugin to the startup folder separately ensuring that the previous version is already deleted.

 

Task 1

Add save date and time to the saved data (class module AhDocData). Fill new data when a new class element is created. Provide save and load code for XML file (class module AhDocColl). These data elements will be used for sorting documents in the Task 2.

Task 2

Change the "Documents" form (form module AhDocStateSaverDocumentsForm) so that it sorts documents by name and by save time. Use interface controls that seem more convenient for you. Provide sorting algorithm.

 

 

 


Etudes for Microsoft Word Programmers. Etude 4.1.

 


Unless otherwise noted, all materials on this site are
2000-2009 Evgeny Akhundzhanov, All Rights Reserved Worldwide
Microsoft is in no way affiliated with, nor offers endorsement of, this site.
www.transcriber.ru | E-mail the Author