QTP连接数据库，并将数据保存至Excel中

网上有很多关于QTP连接数据库的文章，大部分都对，但还是有很多细节问题。今天自己尝试了一下，差点因为这些细节放弃，不过最终搞定了！
首先建立了一个数据库：QTPtest，然后建一章表test1，然后建立五列。
VBS连接此数据库并存Excel如下：

' 定义变量
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

转载于:https://www.cnblogs.com/xubensave/archive/2009/09/01/2430355.html