Intermittent DOC ID Update Issue in Footer of Word 2010 documents

LianeC

Hello Everyone.  I apologize if this has been addressed before, but I have not been able to find information on this particular issue.  Intermittently, several users have experienced opening an existing Word 2010 document from Desksite v. 8.5.2002.12 and finding that the DOC appearing in the footer is the same as another Word document that happens to also be open on the PC or even a recently opened document.  The DOC ID number in the title bar remains correct, but the footer takes on the incorrect DOC ID of another document.  Has anyone experienced this?  I have taken a look at the VBA code for the Footer function and cannot determine what, if anything, is awry in the code.  Does anyone have any ideas as to how I can resolve this issue?  Thanks so much for any assistance you can provide. -- Liane

 

The DOC ID footer codes we have in place are as follows:

 

Option Explicit
Option Compare Text

Public strAuthor As String ' the author of the document to foot
Public strName As String ' the name of the document to foot
Public strNumber As String ' the number of the document to foot
Public strVersion As String ' the version number of the document
Public strClient As String ' the client number
Public strMatter As String ' the matter number
Public objDocument As IManage.NRTDocument

 

Public Sub GetProfileInfo()
Debug.Print "GetProfileInfo"

Dim DocNumber As String
Dim DocName As String
Dim DocVer As String
Dim Author As String
Dim Client As String
Dim Mat As String
Dim ReturnStatus As Integer
Dim Aprop
Dim FileSpec As String

'Begin GetProfileInfo
On Error Resume Next
If ActiveDocument.Variables("Stamp").Value = "" Then
FrmFileStamp.Show
End If

strName = objDocument.GetAttributeByID(nrName)
strNumber = objDocument.GetAttributeByID(nrDocNum)
strVersion = objDocument.GetAttributeByID(nrVersion)
strAuthor = objDocument.GetAttributeByID(nrAuthor)
strClient = objDocument.GetAttributeByID(nrCustom1)
strMatter = objDocument.GetAttributeByID(nrCustom2)

' If ActiveDocument.Variables("Stamp").Value = "" Then
' FrmFileStamp.Show
' Else
For Each Aprop In ActiveDocument.CustomDocumentProperties
Select Case Aprop.Name
Case "DocNumber"
Aprop.Delete
Case "DocVersion"
Aprop.Delete
Case "DocClient"
Aprop.Delete
Case "DocMatter"
Aprop.Delete
Case "DocAuthor"
Aprop.Delete
Case Else
End Select
Next
With ActiveDocument.CustomDocumentProperties
.Add Name:="DocNumber", LinkToContent:=False, Value:=strNumber, Type:=msoPropertyTypeString
.Add Name:="DocVersion", LinkToContent:=False, Value:=strVersion$, Type:=msoPropertyTypeString
.Add Name:="DocClient", LinkToContent:=False, Value:=strClient, Type:=msoPropertyTypeString
.Add Name:="DocMatter", LinkToContent:=False, Value:=strMatter, Type:=msoPropertyTypeString
.Add Name:="DocAuthor", LinkToContent:=False, Value:=strAuthor, Type:=msoPropertyTypeString
End With
' End If
End Sub ' GetProfileInfo

 

Public Sub WGSUpdateFooter()

Debug.Print "WGSUpdateFooter"

'Begin WGSUpdateFooter
On Error Resume Next
ActiveDocument.Variables("Stamp").Delete
Call FootActiveDocument
End Sub

 

Public Sub FootActiveDocument()

On Error GoTo ErrHandler:

Debug.Print "FootActiveDocument"

Dim thisdocument As Document
Dim aFooter As HeaderFooter 'Used to loop through footers to test for iManage field/update
Dim aSection As Section 'Used to loop through sections to test footers
Dim UserView
Dim ViewState
Dim FileSpec

'copied this line from inside to handle change at end of sub.
'Cliff
UserView = ActiveWindow.View.Type
'Begin FootActiveDocument
'Application.ScreenUpdating = False
FileSpec = ActiveDocument.FullName
If InStr(1, "document", FileSpec, vbTextCompare) <> 1 Then
Call GetProfileInfo

UserView = ActiveWindow.View.Type
Set thisdocument = ActiveDocument
With ActiveDocument.Bookmarks
.Add Range:=Selection.Range, Name:="dfwhere"
End With

'ViewState = ActiveWindow.View.ShowAll
'ActiveWindow.View.ShowAll = True 'show all codes
For Each aSection In thisdocument.Sections
For Each aFooter In aSection.Footers
If aFooter.Exists = True Then
aFooter.Range.Fields.Update
End If
Next aFooter
Next aSection

'Selection.GoTo What:=wdGoToBookmark, Name:="dfwhere"
Selection.Find.ClearFormatting
ActiveDocument.Bookmarks("dfwhere").Delete

'ActiveWindow.View.ShowAll = ViewState
'ActiveWindow.View.Type = UserView
'Application.ScreenUpdating = True
End If
'moved the next 2 lines to outside of the if/endif
'Cliff
'ActiveWindow.View.Type = wdNormalView
'ActiveWindow.View.Type = wdPrintView
'ActiveWindow.View.Type = UserView
'Application.ScreenUpdating = True

Exit Sub
ErrHandler:
MsgBox "FootActiveDocument error."

End Sub ' FootActiveDocument