[NEW] ## AutoCorrect- transfer ./. dictionaries ##

[Wai]

Product: MS Office XP (English version)

I have tried both autocorrect macros (one from Microsoft,
one is an amended version from MVP)

Both got stuck at the same place.

Both got the same error:
Run-time error '5941':
The requested member of the collection does not exist.


The errors in both macros:
[NB: be careful about the line breaking due to pasting in
newsgroup]

For Macro8.dot:
The error code is:
.TypeText
Text:=Application.AutoCorrect.Entries.Item(x).Name


The relevant part of the code is:
TotalACEntries = Application.AutoCorrect.Entries.Count
For x = 1 To TotalACEntries
With Selection
.TypeText
Text:=Application.AutoCorrect.Entries.Item(x).Name
.TypeText vbTab

'check for formatting and insert RTF text if
necessary
If Application.AutoCorrect.Entries.Item
(x).RichText = True Then
Application.AutoCorrect.Entries(x).Apply
Range:=Selection.Range
Else
.TypeText
Text:=Application.AutoCorrect.Entries.Item(x).Value
End If

.TypeText vbTab
.TypeText
Text:=Application.AutoCorrect.Entries.Item(x).RichText
.TypeParagraph
End With



For marco9.dot:
The error code is:
MyRange.Text = Application.Autocorrect.Entries
(x).RichText

The relevant area of code is:
For x = 1 To TotalACEntries

MyRange.Text = Application.Autocorrect.Entries(x).Name

Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse

'check for formatting and insert RTF text if necessary
If Application.Autocorrect.Entries(x).RichText = True
Then
Application.Autocorrect.Entries(x).Apply
Range:=MyRange
Else
MyRange.Text = Application.Autocorrect.Entries
(x).Value
End If

If Len(MyRange.Cells(1).Range.Text) = 2 Then
'if the autocorrect entry was a table, the
current cell will be empty
If Left$(Application.Version, 1) = "8" Then
'If Word 97
MyRange.Text = "This entry couldn't be backed
up because it contained a table"
MsgBox "Entry " & Chr(34) &
Application.Autocorrect.Entries(x).Name & Chr(34) & "
couldn't be backed up, because it contained a table."
Else
'Word 2000 or greater
Set MyRange = MyRange.Tables(1).Range
MyRange.Collapse wdCollapseEnd
End If
End If

Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse

MyRange.Text = Application.Autocorrect.Entries
(x).RichText

If x < TotalACEntries Then
Set MyRange = MyRange.Next(wdCell)
MyRange.Collapse
End If

'update status bar
Application.StatusBar = "Adding AutoCorrect Entry: "
& x & " of " & TotalACEntries

Next x

Set MyRange = Nothing
ActiveDocument.Range(0, 0).Select

End Function

..