Bug in MS Word's VBA Document Collection, not sure why this workaround crashes - vba

Question

MS Word 2010 has a bug in its ability to correctly maintain (of all things) the documents collection (link to earliest report found - social.msdn.microsoft.com).
As far as I can tell this bug only impacts Word 2010. Although the documents collection is not maintained, it turns out that the Application.Windows collection is. Hence, for Word 2010 the following code based on the original reporters investigation (see below) and this question on answers.microsoft.com seem to provide a good alternative to the buggy documents collection:
' PURPOSE:
' Return a document collection, work-around for Word 2010 bug
Public Function docCollection() As VBA.Collection
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Can NOT use 'name' - fails to be unique
End If
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
End Function
However, and here's my question, the above code some times fails with error 457 This key is already associated with an element of this collection on line resultDoc.Add foundDoc, foundDoc.FullName. What circumstances could possibly lead to such a failure?
So far the code has only failed on 1 PC running Word 2016. I don't have access to the PC. I did discover that the original version used Document.Name as the key (which was not always unique, so this was changed to Document.Full name)
Assumptions:
Document.FullName will always be unique
Things I've ruled out:
use of Split Window
opening downloaded documents (protected window documents are not counted)
Code that can be used to demonstrate the issue in Word 2010 (adapted from the original report).
' Function Credit Bas258 (https://social.msdn.microsoft.com/profile/bas258)
Function test01() As Boolean
'Adapted to VBA from original: 03-11-2012 1.0 Visual Studio 2008 VB code
Dim oDoc As Word.Document
Dim oDoc0 As Word.Document
Dim oDoc1 As Word.Document
Dim oDoc2 As Word.Document
Dim oDoc3 As Word.Document
Dim oDoc4 As Word.Document
Dim n As Integer
Set WDapp = Application
With WDapp
Debug.Print (Format(Now(), "dd-MM-yyyy") & " MS Office " & .Application.Version)
Set oDoc0 = .Documents.Add: Debug.Print ("add " & oDoc0.Name)
Set oDoc1 = .Documents.Add: Debug.Print ("add " & oDoc1.Name)
Set oDoc2 = .Documents.Add: Debug.Print ("add " & oDoc2.Name)
Set oDoc3 = .Documents.Add: Debug.Print ("add " & oDoc3.Name)
Set oDoc4 = .Documents.Add: Debug.Print ("add " & oDoc4.Name)
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
Debug.Print ("close " & oDoc4.Name)
oDoc4.Close
Set oDoc4 = Nothing
Debug.Print ("close " & oDoc3.Name)
oDoc3.Close
Set oDoc3 = Nothing
For n = 1 To .Documents.Count
Debug.Print ("count " & n & " " & .Documents(n).Name)
Next n
n = 0
For Each oDoc In .Documents
n = n + 1
Debug.Print ("doc " & n & " " & oDoc.Name)
Next oDoc
n = 0
For Each oWin In .Windows
n = n + 1
Debug.Print ("win " & n & " " & oWin.Document.Name)
Next oWin
Debug.Print ("close " & oDoc2.Name)
oDoc2.Close
Set oDoc2 = Nothing
Debug.Print ("close " & oDoc1.Name)
oDoc1.Close
Set oDoc1 = Nothing
Debug.Print ("close " & oDoc0.Name)
oDoc0.Close
Set oDoc0 = Nothing
End With
Set WDapp = Nothing
End Function

Answer 1

This is NOT going to be the accepted answer. Although it does answer the broader question (what could cause this code to crash) it not address the specific crash that I am trying to isolate. Either way there appears to be another bug in MS Word which seemed to be worth capturing for the common good.
This time the bug is with the Windows Collection; and joy of joys, I've confirmed it for both Word 2010 and Word 2016 - both 64 bit apps.
Steps to reproduce the bug are as follows:
In windows explorer enable the Preview Pane
Select a word document FILE so that it is 'previewed'
Open the same document (without losing the 'preview view')
Run the code from the OP, it will crash on this line:
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
It turns out that when a word file is being previewed the Application.Windows.Count property is incremented by the preview; however any attempt to get a property of that window results in Error 5097 - Word has encountered a problem.
So, an improvement to the original code would therefore be:
' PURPOSE:
' Returns a healthy document collection
' - work-around for Word 2010 bug
' - excludes hits from Windows Explorer Preview Pane
Public Function docCollection() As VBA.Collection
On Error GoTo docCollectionError
Dim indexOfAvailableAppWindows As Long
Dim resultDoc As VBA.Collection
Dim foundDoc As Word.Document
Set resultDoc = New Collection
' Use index instead of Each to avoid For Loop Not initialised error, preview pane
For indexOfAvailableAppWindows = 1 To Application.Windows.Count
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' Key must NOT be 'name' - fails to be unique see BUG: 1315
End If
lblSkipThisDoc:
Next indexOfAvailableAppWindows
Set docCollection = resultDoc
Set resultDoc = Nothing
Exit:
Exit Function
docCollectionError:
If Err.Number = 5097 Then ' An open document is also open in the Windows Explorer Preview Pane
Err.Clear
Resume lblSkipThisDoc ' - skip this window
End If
If Err.Number = 457 Then ' Key is already used, but HOW? Unknown cause of error
Err.Clear
Stop 'Resume lblSkipThisDoc ' Is it safe to skip this document, why is there a duplicate?
End If
End Function

Answer 2

There is a setting in MS Word that enables 1 document to be viewed in 2 windows. In Word 2010 it is under the View (Tab): Window > New Window
The new window is counted separately in Application.Windows.Count and returns the same document object, hence the key exists.
For indexOfAvailableAppWindows = 1 To Application.Windows.Count ' <<< New Windows is counted
If Application.Windows(indexOfAvailableAppWindows).Document.Type = wdTypeDocument Then
Set foundDoc = Application.Windows(indexOfAvailableAppWindows).Document
resultDoc.Add foundDoc, foundDoc.FullName ' <<< fails to add 2nd instance of document
End If
So... the solution would likely involve checking the caption of the document:
IMMEDIATE WINDOW:
?foundDoc.Windows(1).Caption
Document2:1