'定义变量
Dim con  
Dim conset
Dim xlsUrl
Dim rs
Dim sql
Dim names
Dim i

'创建连接对象
Set Excelobj=CreateObject ("Excel.Application") 
  '指定一个已经存在的XSL文件路径
xlsUrl = "C:\blanktest1.xls"
 '打开EXCEL
excelObj.workbooks.open(xlsUrl)   
  '设置将数据放在EXCEL中的那一页上(索引从１开始)
Set sheetNew = excelObj.sheets.item(1)

'建立连接，这是一个麻烦点，我这里是连接本机的SQL数据库，Windows默认连接
Set con=createobject("adodb.connection") 
conset="Provider=SQLOLEDB.1;Integrated Security=SSPI;Initial Catalog=QTPtest;Data Source=ASPBJGLL3H5810\SQLEXPRESS"
con.open conset

'查看连接是否已建立
If  con.state=0 Then
 msgbox"failed"
 else 
 msgbox"pass"
End If
'建立空的记录集
Set rs=createobject("adodb.recordset")
'设置SQL语句
sql="select * from test1"
'打开记录集
rs.open sql,con
rs.MoveFirst

'循环取数，数据表列名为aaa/bbb/ccc/ddd/eee
 Do until rs.eof
    A = rs("aaa").value
    B = rs("bbb").value
    C = rs("ccc").value
    D = rs("ddd").value
    E = rs("eee").value
    sheetNew.cells(i+1,1).value = A '列赋值
    sheetNew.cells(i+1,2).value = B '列赋值
    sheetNew.cells(i+1,3).value = C '列赋值
    sheetNew.cells(i+1,4).value = D '列赋值
    sheetNew.cells(i+1,5).value = E '列赋值
    i = i + 1
    rs.movenext
 Loop

'文档为只读，目前无法保存，但实际数据已进入
ExcelObj.activeworkbook.saveas "C:\blanktest1.xls"

 '关闭对象
ExcelObj.quit
'清空对象
set ExcelObj = nothing

'关闭连接
con.close
'释放Connection对象
Set con=nothing