Random Disk Error Running Word VBA Macro

[Steven Drenker]

I've written the macro (below) to clean up the formatting of text I copy
from web pages. I set up two arrays, vFindText and vReplText, to execute the
find & replace. The macro occasionally and randomly crashes when executing
the Find/replace on one of the array elements (about the fifth element, but
not always in the same place).

The error message is "There is an unrecoverable disk error on file World
Work File S_2. The disk you're working on has a media problem that prevents
Word from using it. Try the following:
* Try formatting another disk
* Save the document to another disk"

I click OK in the error dialog box and Word crashes. I'm running a Mac
PowerBook G4, 512 RAM, 70 Gig HDD with 40 Gig available, MS Word X Service
Release 1. I don't have disk problems with Word or other programs.

Any ideas? Is VBA stable in this version of Word.

Thanks for any help.

Steve


Sub NewJobListing()
' Adapted 2/7/03 from Jonathon West, Word MVP, http://www.multilinker.com
Const ArrayUBound = 24
Dim vFindText(ArrayUBound) As String
Dim vReplText(ArrayUBound) As String
Dim i As Integer
Dim MyRange As Range
Dim rPara As Range

Dim iParaCount As Integer

Application.ScreenUpdating = False

Documents.Add DocumentType:=wdNewBlankDocument

Selection.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
wdInLine, DisplayAsIcon:=False

' NOTE: Put the "^p^p" last after the previous cleanup of paragraph returns
' has been completed (i.e., spaces before and after other para returns)
vFindText(0) = "( " ' Space after left paren
vReplText(0) = "("

vFindText(1) = " )"
vReplText(1) = ")"

vFindText(2) = " ,"
vReplText(2) = ","

vFindText(3) = " ."
vReplText(3) = "."

vFindText(4) = " " ' Two spaces
vReplText(4) = " "

vFindText(5) = " ^p" ' Space in front of paragraph return
vReplText(5) = "^p"

vFindText(6) = "^p "
vReplText(6) = "^p"

vFindText(7) = "^l" ' Line return
vReplText(7) = "^p" ' Line return to para return

vFindText(8) = "--" ' Two hyphens to one En-dash
vReplText(8) = "^="

vFindText(9) = ",,"
vReplText(9) = ","

vFindText(10) = "..." ' Ellipsis
vReplText(10) = "Ö"

vFindText(11) = ".." ' Double periods (after completing ellipsis
conversion)
vReplText(11) = "."

vFindText(12) = "Ö " ' Space after ellipsis
vReplText(12) = "Ö"

vFindText(13) = "``" ' Left double quotes
vReplText(13) = """"

vFindText(14) = "`" ' Left single quote
vReplText(14) = "'"

vFindText(15) = "''" ' Double single quotes
vReplText(15) = """"

vFindText(16) = " ^= " ' Clean up en-dash formatting to single
non-breaking space before and after (16 - 19)
vReplText(16) = "|"

vFindText(17) = " ^="
vReplText(17) = "|"

vFindText(18) = "^= "
vReplText(18) = "|"

vFindText(19) = "|"
vReplText(19) = "^s^=^s"

vFindText(20) = " €" ' Remove space before bullets
vReplText(20) = "€"

vFindText(21) = "€ " ' Convert space after bullets to tab
vReplText(21) = "€^t"

vFindText(22) = "^p^t" ' Erase tab at beginning of paragraph
vReplText(22) = "^p"

vFindText(23) = "^t^t" ' Convert double tabs to single tab
vReplText(23) = "^t"

vFindText(24) = "^p^p" ' Convert double para return to single para
return
vReplText(24) = "^p"

With ActiveDocument.Content.Find
.ClearFormatting
For i = 0 To UBound(vFindText)
Selection.HomeKey Unit:=wdStory

Debug.Print i & " Find: " & vFindText(i)
Debug.Print i & " Replace: " & vReplText(i) & vbCrLf

If i = UBound(vFindText) Then
' Find & Replace won't delete the first or last paragraph returns
' in a document if they are empty. The lines in this If-Then block
' execute after completing all other cleanup except multiple CrLf
' It removes multiple returns at the beginning and the end of the
' document. This avoids the last cleanup code (^p^p --> ^p) going
' into an infinite loop if there is a double return at the end of
' the document.

Set MyRange = ActiveDocument.Paragraphs(1).Range
Do While MyRange.Text = vbCr
MyRange.Delete
Set MyRange = ActiveDocument.Paragraphs(1).Range
Loop

Set MyRange = ActiveDocument.Paragraphs.Last.Range
Do While MyRange.Text = vbCr
MyRange.Delete
Set MyRange = ActiveDocument.Paragraphs.Last.Range
Loop
End If

Do While .Execute(FindText:=vFindText(i), _
Forward:=True, _
Format:=True) = True
.Execute FindText:=vFindText(i), _
Forward:=True, _
Format:=True, _
ReplaceWith:=vReplText(i), _
Replace:=wdReplaceAll
Loop
Next i
End With

' Format the document
Selection.WholeStory
With Selection
.Range.Style = ActiveDocument.Styles(wdStyleNormal)
.Font.Name = "Arial"
.Font.Size = 10
.ParagraphFormat.SpaceBefore = 0
.HomeKey Unit:=wdStory
End With

End Sub

 

[Peter]

googling the error text (http://www.google.com/search?source...There+is+an+unrecoverable+disk+error+on+file"), found the following articles:

http://www.kbalertz.com/kb_224030.aspx
http://www.kbalertz.com/kb_224068.aspx
https://lists.aas.duke.edu/pipermail/ntgroup/2003-February/001160.html
http://www.macwindows.com/jaguar.html

They all deal with using network shares, though, so I don't know how appropriate they are to your scenario. There is a mention that an upgrade to OSX.2.4 was a fix for some.

hth,

-Peter