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 'i加1,准备把下一记录相关字段的值保存到工作表的下一行
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 'i加1,准备把下一记录相关字段的值保存到工作表的下一行
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 'i加1,准备把下一记录相关字段的值保存到工作表的下一行
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 'i加1,准备把下一记录相关字段的值保存到工作表的下一行
Loop
cn.Close
Set cn = Nothing
Set rs = Nothing
End Sub