博奥清单导出Excel后单位批量替换

Option Explicit

If Wscript.Arguments.Count = 0 Then
    WScript.Echo Chr(10) & _
    "[正确操作]" & Chr(10) & Chr(10) & _
    Chr(9) & "拖拽导出的Excel文件到本程序" & Chr(10) & Chr(10) & _
    "[错误操作]" & Chr(10) & Chr(10) & _
    Chr(9) & "双击本程序"
    WScript.Quit
End If

Dim xlsFilePath
xlsFilePath=WScript.Arguments(0)

Dim Wshell
Set Wshell=CreateObject("Wscript.Shell")

If LCase(Right(WScript.FullName,11)) = "wscript.exe" Then
    Wshell.Run "CScript.exe //nologo" & _
    Chr(32) & _
    Chr(34) & WScript.ScriptFullName & Chr(34) & _
    Chr(32) & _
    Chr(34) & WScript.Arguments(0) & Chr(34)
    WScript.Quit
End If

WScript.Echo "正在运行,请等待......"

Dim oExcel,oWorkbook,Sheet
On Error Resume Next
Set oExcel = GetObject(,"Excel.Application")
If Err Then
    WScript.Echo Err.Description
    Err.Clear
    Set oExcel = CreateObject("Excel.Application")
    oExcel.Visible = False
End If
Set oWorkbook = oExcel.Workbooks.Open(xlsFilePath)
If Err Then
    Err.Clear
    Wshell.Popup "无法打开指定的文件，可能的原因有：" & Chr(10) & _
    "1、本机没有安装Microsoft Office 2003、2007、2010或以上版本。" & Chr(10) & _
    "2、需要处理的文件已经打开或被其它程序占用，请关闭文件后重新使用本程序。", 10 , "提示", 16+4096
    WScript.Quit
End If
On Error Goto 0
oExcel.DisplayAlerts = False

Dim CurrentPath
CurrentPath = CreateObject("Scripting.FileSystemObject").GetFile(Wscript.ScriptFullName).ParentFolder.Path
For Each Sheet In oWorkbook.Worksheets
    Sheet.Activate
    Wscript.Echo "Replace:" & Sheet.Name
    oExcel.Cells.Replace "㎡", "m2", 2, 1, False, False, False
    oExcel.Cells.Replace "", "m2", 2, 1, False, False, False
    oExcel.Cells.Replace "", "m3", 2, 1, False, False, False
    oExcel.Cells.Replace "延长米", "m", 2, 1, False, False, False
Next
oWorkbook.Worksheets(1).Select
oWorkbook.Save
oExcel.DisplayAlerts = True
oWorkbook.Close

Set oExcel = Nothing
Set oWorkbook = Nothing

Wshell.Popup "经过一段时间的浴血奋战，终于搞定了所有的单位替换。", 10, "博奥单位替换", 48