vbscript控制Excel問題

程序如下
set iCon = CreateObject("Adodb.connection")
set rs = CreateObject("Adodb.Recordset")

set xlapp = CreateObject("Excel.Application")
set ExcelBook = xlapp.workbooks.open("D:\2007-11\20080403job\CMXRVM.csv")
set ExcelSheet = ExcelBook.ActiveSheet

xlapp.visible = true

strCon = "UID=sa;PWD=123;Database=SAMCAT;"& _
"Driver={SQL Server};"& _
"Server=.;Provider=SQLOLEDB.1"
iCon.Open strCon


strSQLrs = "select * from CAT_ExchangeRates"

rs.Open strSQLrs,iCon,adOpenForwardOnly,1,adCmdText

msgbox rs.EOF

do while count<>2
arr(suffix) = ExcelBook.worksheets("CMXRVM").cells(i,j).value
if arr(suffix)="" then
count = count + 1
end if

suffix = suffix + 1
j = j + 1

if j>5 then
suffix = 0
j = 1
i = i + 1
if arr(3)="CLOSE" then
strSQL = "insert into CAT_ExchangeRates(nvrCurrency1,nvrCurrency2,ftRate,nvrImporSystemDate)"& _
" values('"&arr(0)&"','"&arr(1)&"','"&arr(4)&"','"&arr(2)&"')"
iCon.Execute strSQL
end if
end if
loop

msgbox "insert ok!"

我抽取Excel內容再插入數據庫，但Excel中的數據有幾千條，執行完要等很久，有什麼辦法可以加快執行的速度呢？