VBA_EXECL_SQL测试的例子

VBA_EXECL_SQL测试的例子

EXECL是二维表,SQL也是二维表,如果这两个能结合该有多好呀,把SQL数据调到EXECL中之后,你是打印、编辑想做啥就做啥有多方便呀,用VBA就可实现把SQL数据调到EXECL中的想法,用SQL编写存储过程也可以将数据存到EXECL中,如果用VBA执行更简单明了,用SQL语句不能指向EXECL中的行和列,用VBA就可以随意指定行和列,还可以设计表头,包括颜色、字体、框线、预置公式都可以实现。

我试验了几个例子,共大家分享。

'****************EXECL中用VBA调用一条SQL语句

Sub SQLS1()

  Set cnn = CreateObject("ADODB.Connection")

  cnn.ConnectionString = "Driver={SQL Server};server=127.0.0.1;uid=sa;pwd=;database=AIS20091223202739"

  cnn.Open

  Set rs = CreateObject("ADODB.recordset")

  rs.Open "select  fnumber,fname  from t_account", cnn, 0

 

  i = 1

  Set sht = ThisWorkbook.Worksheets("sheet1")   'sht指向当前工作簿的sheet1工作表

  Do While Not rs.EOF              '当数据指针未移到记录集末尾时,循环下列操作

  sht.Cells(i, 1) = rs("fnumber")  '把当前记录的字段1的值保存到sheet1工作表的第i行第1

  sht.Cells(i, 2) = rs("fname")    '把当前字段2的值保存到sheet1工作表的第i行第2

  rs.MoveNext                      '把指针移向下一条记录

 

  i = i + 1                        'i1,准备把下一记录相关字段的值保存到工作表的下一行

  Loop

     

  cnn.Close

  Set cnn = Nothing

  Set rs = Nothing

   

  End Sub

 

  '****************EXECL中用VBA调用存储过程(不带参数)

 

Sub SQLS2()

Set cn = CreateObject("ADODB.Connection")

Set cmd = CreateObject("ADODB.Command")

cn.ConnectionString = "Driver={SQL Server};server=127.0.0.1;uid=sa;pwd=;database=AIS20091223202739"

cn.Open

Set rs = CreateObject("ADODB.recordset")

 

 

Dim i As Integer, sht As Worksheet

 

cmd.ActiveConnection = cn

 

cmd.CommandType = 4                   'sqlstoredProc

cmd.CommandText = "JZC_test"

 

Set rs = cmd.Execute

 

 i = 1

  Set sht = ThisWorkbook.Worksheets("sheet2")   'sht指向当前工作簿的sheet1工作表

  Do While Not rs.EOF                 '当数据指针未移到记录集末尾时,循环下列操作

  sht.Cells(i, 1) = rs("faccountid")  '把当前记录的字段1的值保存到sheet1工作表的第i行第1

  sht.Cells(i, 2) = rs("fnumber")     '把当前字段2的值保存到sheet1工作表的第i行第2

  sht.Cells(i, 3) = rs("fname")

  rs.MoveNext                         '把指针移向下一条记录

 

  i = i + 1                           'i1,准备把下一记录相关字段的值保存到工作表的下一行

  Loop

 

  cn.Close

  Set cn = Nothing

  Set rs = Nothing

   

  End Sub

  

  '****************EXECL中用VBA调用存储过程(复杂存储过程-不带参数)

 

Sub SQLS3()

Set cn = CreateObject("ADODB.Connection")

Set cmd = CreateObject("ADODB.Command")

cn.ConnectionString = "Driver={SQL Server};server=127.0.0.1;uid=sa;pwd=;database=AIS20091223202739"

cn.Open

Set rs = CreateObject("ADODB.recordset")

 

 

Dim i As Integer, sht As Worksheet

 

cmd.ActiveConnection = cn

 

cmd.CommandType = 4                   'adCmdStoredProc

cmd.CommandText = "JZC_standardcost"

 

Set rs = cmd.Execute

 

 i = 1

  Set sht = ThisWorkbook.Worksheets("sheet3")   'sht指向当前工作簿的sheet1工作表

  Do While Not rs.EOF                 '当数据指针未移到记录集末尾时,循环下列操作

  sht.Cells(i, 1) = rs("Fbomnumber")  '把当前记录的字段1的值保存到sheet1工作表的第i行第1

  sht.Cells(i, 2) = rs("Fitemid")     '把当前字段2的值保存到sheet1工作表的第i行第2

  sht.Cells(i, 3) = rs("Fnumber")

  rs.MoveNext                         '把指针移向下一条记录

 

  i = i + 1                           'i1,准备把下一记录相关字段的值保存到工作表的下一行

  Loop

 

  cn.Close

  Set cn = Nothing

  Set rs = Nothing

   

  End Sub

   

  '****************EXECL中用VBA调用存储过程(复杂存储过程-带参数)

 

Sub SQLS4()

Set cn = CreateObject("ADODB.Connection")

Set cmd = CreateObject("ADODB.Command")

cn.ConnectionString = "Driver={SQL Server};server=127.0.0.1;uid=sa;pwd=;database=AIS20091223202739"

cn.Open

Set rs = CreateObject("ADODB.recordset")

 

 

Dim i As Integer, sht As Worksheet

 

cmd.ActiveConnection = cn

 

cmd.CommandType = 4                   'adCmdStoredProc

cmd.CommandText = "JZC_standardcost1"

 

'Dim B_Date As Date, E_Date As Date

 'B_Date = "2009-11-01"

' E_Date = "2009-11-30"

 

'cmd.Parameters.Refresh

 

'Set param = cmd.CreateParameter("@B_date", addate, adParamInput, 16, "2009-11-01")  'Trim(txttruename.Text))

Set param = cmd.CreateParameter("@B_date", 135, 1, 16, "2009-11-01")  'Trim(txttruename.Text))

cmd.Parameters.Append param

Set param = cmd.CreateParameter("@E_date", 135, 1, 16, "2009-11-30")  'Trim(txttruename.Text))

cmd.Parameters.Append param

 

'cmd.Parameters("@B_date").Value = Date '存储过程中参数的值(存储过程中只有一个参数)

'cmd.Parameters("@E_dtae").Value = Date '存储过程中参数的值(存储过程中只有一个参数)

 

Set rs = cmd.Execute

 

 i = 1

  Set sht = ThisWorkbook.Worksheets("sheet4")   'sht指向当前工作簿的sheet1工作表

  Do While Not rs.EOF                 '当数据指针未移到记录集末尾时,循环下列操作

  sht.Cells(i, 1) = rs("Finterid")  '把当前记录的字段1的值保存到sheet1工作表的第i行第1

  sht.Cells(i, 2) = rs("Fbomnumber")     '把当前字段2的值保存到sheet1工作表的第i行第2

  sht.Cells(i, 3) = rs("Fitemid")

  sht.Cells(i, 4) = rs("Fnumber")

  sht.Cells(i, 5) = rs("Fmodel")

  sht.Cells(i, 6) = rs("Funitid")

  sht.Cells(i, 7) = rs("Funitname")

  sht.Cells(i, 8) = rs("Fqty")

  sht.Cells(i, 9) = rs("Ftrantype")

  sht.Cells(i, 10) = rs("Fcustid")

  sht.Cells(i, 11) = rs("Fcustname")

  sht.Cells(i, 12) = rs("Fzjcl")

  sht.Cells(i, 13) = rs("Fzjrg")

  sht.Cells(i, 14) = rs("Fbdzzfy")

  sht.Cells(i, 15) = rs("Fgdzzfy")

  sht.Cells(i, 16) = rs("Fwwjgf")

  sht.Cells(i, 17) = rs("Fcost")

 

  rs.MoveNext                         '把指针移向下一条记录

 

  i = i + 1                           'i1,准备把下一记录相关字段的值保存到工作表的下一行

  Loop

 

  cn.Close

  Set cn = Nothing

  Set rs = Nothing

   

  End Sub

  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值