VBA替换文件名

Sub btnChange_Click()
　　NewReplaceText
End Sub

Sub NewReplaceText()
　　With Application.FileDialog(msoFileDialogFilePicker)
　　.AllowMultiSelect = False
　　.Filters.Clear
　　.Filters.Add "Excel Files", "*.xls;*.xlw"
　　.Filters.Add "All Files", "*.*"
　　If .Show = -1 Then
　　Dim Fn$, MyPath$, MyFile$, NewName$, myText
　　Dim filePath, fileExt As String
　　filePath = .SelectedItems(1)
　　FileInfo = Readbinary(filePath)
　　fileExt = Right(filePath, Len(filePath) - InStrRev(filePath, "."))
　　Open "temp" For Append As #2
　　For i = 2 To UsedRange.Rows.Count
　　If Cells(i, 1) <> "" Then
　　oldName = Cells(i, 1)
　　NewName = Cells(i, 2)
　　If oldName <> NewName Then
　　If InStr(FileInfo, oldName) > 0 Then
　　FileInfo = Replace(FileInfo, oldName, NewName)
　　End If
　　End If
　　End If
　　Next
　　Print #2, FileInfo
　　Close #2
　　Name "temp" As "NewReplacedFile." & fileExt
　　End If
　　End With
End Sub

Function Readbinary(ByVal FullNames As String) As String
　　On Error GoTo errh
　　Dim fNum As Integer, Length1 As Long, w1 As String, Isopen As Boolean
　　fNum = FreeFile()
　　Open FullNames For Binary As #fNum
　　Isopen = True
　　Length1 = LOF(fNum)
　　w1 = Space$(Length1)
　　Seek #fNum, 1
　　Get #fNum, , w1
　　Close
　　Readbinary = w1
　　errh:
　　If Isopen Then Close
　　'MsgBox Err.Description
End Function