OK, try:
Code:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
.Font.Hidden = True
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = True
.Font.Hidden = True
.Replacement.Font.Hidden = False
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
.Text = "\<xs:element name[!\>]@\>"
.Replacement.Text = "^&"
.Execute Replace:=wdReplaceAll
DoEvents
.Text = "*^13"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
DoEvents
.Format = False
.Text = "m[ai][nx]Occurs[!\>]@\>"
.Replacement.Text = ">"
.Execute Replace:=wdReplaceAll
DoEvents
.Text = "\<xs:element name=([!\>]@)type=([!\>]@)\>"
.Replacement.Text = "\1^t\2^p"
.Execute Replace:=wdReplaceAll
.Text = "\<xs:element name=([!\>]@)\>"
.Replacement.Text = "\1^t^p"
.Execute Replace:=wdReplaceAll
DoEvents
.Text = " ([^13^t])"
.Replacement.Text = "\1"
.Execute Replace:=wdReplaceAll
.Text = Chr(34)
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
.Text = "^13[ ^t]*^13"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
.Text = "[^13]{2,}"
.Replacement.Text = "^p"
.Execute Replace:=wdReplaceAll
DoEvents
End With
If .Characters.First <> vbCr Then .InsertBefore vbCr
.InsertBefore "NAME" & vbTab & "TYPE"
.ConvertToTable vbTab, 2
End With
Application.ScreenUpdating = True
End Sub