Importing sub documents with AddFromFile is creating multiple styles

[Doug Martin via OfficeKB.com]

I use the macro below to import about 13 documents (full list not listed here to save space) into a Main document using Word 2000. All of the documents have been saved off of the Main document (using the main doc as a template) and they all run off the same .dot template for the styles.

Now, my problem is that it has been working fine up until I tweaked something or changed a setting somewhere (which I cannot think what) and now when I run the macro it brings all the documents in perfectly but multiplies most of the styles with the same name from the 13 documents ie:
New bullet
New bullet1
New bullet2
New bullet3 etc etc up to 13.
This problem also exists if I try and manually copy all the information from the sub documents into the main document (although it doesn?t seem as bad).

My question is, is there a line of code I can add or a setting which will rectify this problem? I have trawled through many forums regarding this but have yet to find a solution.

Any help will be much appreciated,



Sub ImportSubDocuments()
On Error GoTo ImportSubDocuments_Err

Dim sFile As String
' ActiveDocument.Paragraphs.TabStops.ClearAll
ActiveWindow.ActivePane.View.Type = wdMasterView
Selection.Paragraphs.OutlinePromote

'stop the message box informing about styles being different
Application.DisplayAlerts = wdAlertsNone

sFile = "Introduction.doc"
ChangeFileOpenDirectory _
sMainDirectory & "Introduction\"
ActiveDocument.Subdocuments.AddFromFile Name:=sFile, _
ConfirmConversions:=False, ReadOnly:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:=""


sFile = "Consumer.doc"
ChangeFileOpenDirectory _
sMainDirectory & "Consumer\"
Selection.Range.Subdocuments.AddFromFile Name:=sFile, _
ConfirmConversions:=False, ReadOnly:=False, PasswordDocument:="", _
PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _
WritePasswordTemplate:=""

Exit Sub

ImportSubDocuments_Err:
If Err.Number = 5174 Then
MsgBox "Subdocument " & sFile & " can not be found, please check document name and location", vbExclamation, "Subdocument not found"
Else
MsgBox Err.Description & vbNewLine & Err.Number, vbExclamation, "Error loading subdocuments"
End If
End Sub