'EXCELa.VBS '直接將查詢數據結果生成 EXCEL 表，稍做修改后即可 
'改成ASP文件放在服務器上面向客戶 

option Explicit 
dim conn,strConnString 
Set conn = WScript.CreateObject("ADODB.Connection") 
on error resume next 
strConnString ="Provider=SQLOLEDB.1;Password=UP;" & _ 
"Persist Security Info=True;User ID=UI;" & _ 
"Initial Catalog=UCOOl;" & _ 
"Data Source=111.111.111.111;Connect Timeout=15" 
conn.Open strConnString 
if err.number <> 0 Then 
WScript.echo "數據庫鏈接不暢!;" 
WScript.Quit 
end If 
on error goto 0 
Dim rs,sql 
set rs=WScript.createobject("adodb.recordset") 
on error resume next 
sql="select name,dw,dwdz,zw,sex,email from t1 order by id desc" 
rs.Open sql, conn 
if err.number <> 0 Then 
WScript.echo "查詢語句有誤!;" 
WScript.Quit 
end If 
on error goto 0 
dim rsname,i 
on error resume next 
rsname=RS( 0 ).name 
for i = 1 to RS.Fields.Count - 1 
rsname=rsname&chr(9)&RS( i ).name 
next 
rsname=rsname&chr(13) 
Dim strdate 
strdate=rsname&rs.GetString(2,-1,,," ") 
if err.number <> 0 Then 
WScript.echo "保存數據時出錯!;" 
WScript.Quit 
end If 
Set conn=Nothing 
Set rs=Nothing 
on error goto 0 
Dim fs,fl,path,ntime 
Set fs=WScript.CreateObject("scripting.filesystemobject") 
path=WScript.scriptfullname 
path=left(path,instrrev(path,"\")) 
ntime=cstr(Now) 
ntime=Replace(ntime,":","_") 
on error resume next 
Set fl=fs.CreateTextFile(path&ntime&".xls",true) 
fl.Write strdate 
if err.number <> 0 Then 
WScript.echo "建立文件出錯!;" 
end If