一种批量翻译cdr文件的方法

Sub cdrFY()
'cdrpath = InputBox("请输入cdr文件路径：", "FilePath", "示例：E:\cdrFiles") & "\"
'th_old = InputBox("请输入cdr旧编号(任意一个或多个，以英文逗号分隔):", "th_old ", "")
'arr = Split(th_old, ",")
cdrpath = "E:\cdr\"
'读取翻译映射表
Dim xlsobj As New Excel.Application
xlsobj.Workbooks.Open cdrpath & "1.xlsx", , ReadOnly
n = Cells(Rows.Count, "a").End(xlUp).Row
arr = xlsobj.ActiveWorkbook.Worksheets("Sheet1").Range("a2:b" & n)
'遍历cdr
cdrFile = Dir(cdrpath & "*.cdr")
Do While cdrFile <> ""
Set Doc = OpenDocument(cdrpath & cdrFile)
For i = 0 To UBound(arr) - 1
    For Each pg In ActiveDocument.Pages
            For Each Atext In pg.ActiveLayer.Shapes
                If Atext.Type = cdrTextShape Then
                   If Atext.Text.Story.Text = arr(i + 1, 1) Then
                   Atext.Text.Story.Text = arr(i + 1, 2)
                   Atext.Text.Story.Font = "Arial"
                    Atext.Text.Story.Size = "6"
                   End If
                End If
            Next
    Next
Next
ActiveDocument.Save
ActiveDocument.Close
cdrFile = Dir
Loop
End Sub