Sub temp_2()
Const myPath = "D:\Temp\"
Const myFormatFile = "*.cdr"
Const myFindText = "017 200 200"
Const myReplaceText = "017 211 201"
Dim myArrOpen As String
Dim s As Shape, p As Page
myArrOpen = ""
ddd = VBA.Dir(myPath & myFormatFile, vbNormal)
I = 1
While Not ddd = ""
myArrOpen = myArrOpen & ddd & Chr(124)
ddd = VBA.Dir
Wend
myArrOpen = Left(myArrOpen, Len(myArrOpen) - 1)
For Each ddd In Split(myArrOpen, Chr(124))
Application.OpenDocument(myPath & ddd).Activate
For Each p In ActiveDocument.Pages
For Each s In p.Shapes.FindShapes(Type:=cdrTextShape)
s.Text.Replace myFindText, myReplaceText, False, 1, True, True
Next s
Next p
ActiveDocument.Save
ActiveDocument.Close
Next ddd
End Sub