Question

EXCEL VBA怎么读写SQLSERVER 数据库

需求：1、读取数据库：以EXCEL表中的一列数据作为查询条件，到SQL数据库中取数并填充到EXCEL里；
2、写数据库：将表格里的数据写到表里，写入前要检查数据的合法性。

请给出比较具体的例子：怎么连数据库、读取单元格、传参数、怎么填充单元格等。
谢谢！

Answer 1

Sub 按钮1_Click()
Dim i As Integer, j As Integer, sht As Worksheet 'i,j为整数变量；sht 为excel工作表对象变量，指向某一工作表
'Dim cn As New ADODB.Connection '定义数据链接对象 ，保存连接数据库信息；请先添加ADO引用
'Dim rs As New ADODB.Recordset '定义记录集对象，保存数据表
‘工具 ---〉引用 ---〉Microsoft ActiveX data objects ....
'下面两句就不需要增加引用ADO
Set cn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
Dim strCn As String, strSQL As String '字符串变量
Dim strCond As String
strCn = "Provider=sqloledb;Server=R9HDET7;Database=dbname;Uid=username;Pwd=password" '定义数据库链接字符串

'下面的语句将读取态衫数据表数据，并将它保存到excel工作表中：工作表为一张两维表，记录集也是一张两维表

strSQL = "select CUSTOMER_NAME from VSC_BI_CUSTOMER " '定义SQL查询命令字符串

cn.Open strCn '与数据库建立连接，如果成功，返回连接对碰肢象cn
rs.Open strSQL, cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中
i = 2

Set sht = ThisWorkbook.Worksheets("Test") '把sht指向当前工作簿的Test工作表
Do While Not rs.EOF '当数据指针未移到记录集末尾时，循环下列操作
sht.Cells(i, 1) = rs("CUSTOMER_NAME") '把当前记录的字段1的值保存到sheet1工作表的第i行第1列
rs.MoveNext '把指针移向下一条记录
i = i + 1 'i加1，准备把下一记录相关字段的值保存到工作表的下一行
Loop '循环
rs.Close '关闭记录集，笑闭世至此，程序将把某数据表的字段1保存在excel工作表sheet1的第1列，行数等于数据表的记录数

cn.Close '关闭数据库链接,释放资源
End Sub

Answer 2

这是EXCEL与SQL结合的一般性的运用，我先给出一些示范代码，自己修改一下。
其实这样的例子网上也很多的。
1.先加入对ADODB的引用
2.定义数羡升耐据库连接的全局变量
dim cnDB as adodb.connection
3.函数
'2009/4/1
'打开与系统数据库的连接,返回数据库是否兄春打开
Public Function OpenDatabase() As Boolean
Dim B As Boolean

B = True

With cnDB
If .State <> adStateOpen Then '如果数据库连接未笑晌打开
On Error Resume Next
.Close '先关闭数据库连接，忽略任何错误

'2011/3/15变更服务器，73.1 -> 84.36(hzrpps)
S = "driver={sql server};server=服务器IP;uid=SQL用户名;"
S = S & "pwd=用户密码;database=数据库名;"

.ConnectionString = S
Err.Clear
.Open
If Err.Number <> 0 Then
B = False
MsgBox "连接数据库时发生错误，请联络。", vbInformation
End If
End If
End With

OpenDatabase = B

End Function

'根据指定的sql语句，取得记录列表
Public Function GetRecordList(ByVal sSql As String) As String
Dim tmpRs As New ADODB.Recordset

On Error GoTo Err1

S = ""

If Len(sSql) > 0 Then 'sql语句不是0长度

If OpenDatabase Then '打开数据库成功

With tmpRs
.Open sSql, cnDB, adOpenKeyset, adLockOptimistic

If Not (.BOF And .EOF) Then '有记录存在
If .RecordCount = 1 Then '如果仅有一条记录,同不要","分隔号
S = .Fields(0).Value '仅取第一个字段

Else
' For i = 1 To .RecordCount
' S = S & .Fields(0).Value & "," '用逗号分隔
' .MoveNext
' Next
Do While Not .EOF
S = S & .Fields(0).Value & "," '用逗号分隔
.MoveNext
Loop
S = Left(S, Len(S) - 1)
End If
End If

.Close
End With

End If

End If

GetRecordList = S '返回值

Exit Function

Err1:
MsgBox "系统取得数据时发生错误,请联络。", vbExclamation

End Function

Answer 3

Dim cn As New ADODB.Connection '定旅瞎义数据链接对象 ，保存连接数据库信息；请先添加ADO引用
Dim rs As New ADODB.Recordset '定义记森镇如录集对此启象，保存数据表
Dim strCn As String, strSQL As String '字符串变量
Dim i As Integer, j As Integer, sht As Worksheet

strCn = "Provider=SQLOLEDB.1;Password=密码;Persist Security Info=True;User ID=用户;Initial Catalog=hrlink ;Data Source=IP地址"
strSQL = "select * from 表"

strSQL1 = "select * from 表"
cn.Open strCn
rs.Open strSQL, cn

Answer 4

Function qushuju ()

'定义变量
Dim i As Double
Dim j As Double
Dim a As String
Dim b As String
Dim c As String
Dim d As String

Dim temp_1 As String
Dim temp_2 As String
Dim temp_3 As String
Dim temp_4 As String
Dim temp_5 As Single
Dim temp_6 As Single
Dim temp_7 As Single
Dim temp_8 As Single
Dim temp_9 As Single
Dim temp_10 As Single
Dim temp_11 As Single
Dim temp_12 As Single
Dim temp_13 As Single
Dim temp_14 As Single
Dim temp_15 As Single
Dim temp_16 As Single
Dim temp_17 As Single
Dim temp_18 As Single
Dim temp_19 As Single
Dim temp_20 As Single
Dim temp_21 As Single
Dim temp_22 As Single
Dim temp_23 As Single
Dim temp_24 As Single
Dim temp_25 As Single
Dim x()
x = Array(temp_1, temp_2, temp_3, temp_4, temp_5, temp_6, temp_7, temp_8, temp_9, temp_10, temp_11, temp_12, temp_13, temp_14, temp_15, temp_16, temp_17, temp_18, temp19, temp20, temp21, temp22, temp23, temp24, temp25)

'初始化变量
i = 1
j = 2

'初始化表格
ActiveWorkbook.Sheets(2).Select
ActiveWorkbook.Sheets(2).Cells.Select
Selection.ClearContents

'制表头
Sheets(2).Cells(1, 1) = "DATE"
Sheets(2).Cells(1, 2) = "Period"
Sheets(2).Cells(1, 3) = "Exchid"
Sheets(2).Cells(1, 4) = "cellid"

Sheets(2).Cells(1, 5) = "小区名称"
Sheets(2).Cells(1, 6) = "镇区"
Sheets(2).Cells(1, 7) = "频率"
Sheets(2).Cells(1, 8) = "纤指设备类型"
Sheets(2).Cells(1, 9) = "设备代维公司"

Sheets(2).Cells(1, 10) = "TRU_MO"
Sheets(2).Cells(1, 11) = "TRU_STS"
Sheets(2).Cells(1, 12) = "T完好率"
Sheets(2).Cells(1, 13) = "定义信道"
Sheets(2).Cells(1, 14) = "可用信道"
Sheets(2).Cells(1, 15) = "话务量"
Sheets(2).Cells(1, 16) = "F话务量"
Sheets(2).Cells(1, 17) = "H话务量"
Sheets(2).Cells(1, 18) = "平均分配PDCH"
Sheets(2).Cells(1, 19) = "混合话务量"
Sheets(2).Cells(1, 20) = "STRU数"
Sheets(2).Cells(1, 21) = "配桥坦置EPDCH数"
Sheets(2).Cells(1, 22) = "EPDCH分配数"
Sheets(2).Cells(1, 23) = "EPDCH复用敏竖桐度"
Sheets(2).Cells(1, 24) = "统计时段数"
Sheets(2).Cells(1, 25) = "平均混合话务量"

'连接SQL数据库
Dim conn As New ADODB.Connection
connStr = "Driver={SQL Server};DataBase=optimize;Server=10.249.5.49;UID=abc;PWD=abc"
conn.Open connStr '连接数据库
Dim rs As New Recordset
'举例：
'connStr = "Driver={SQL Server};DataBase=test;Server=(local);UID=sa;PWD=123"
'test是数据库名
'(local)是服务器名或IP地址，可以：192.168.1.1，可以是：www.sina.com.cn
'sa是数据库用户
'123是数据库用户密码
Sql = "select * from obj_bsc_hwcellmax3" '查表
rs.Open Sql, conn, 3, 3
Do While Not rs.EOF
'下面是数据库里头表格的字段名对应的数据，可以根据自己的数据库表的字段进行修改
x(0) = rs("DATE")
x(1) = rs("Period")
x(2) = rs("Exchid")
x(3) = rs("CellID")
x(4) = rs("小区名称")
x(5) = rs("镇区")
x(6) = rs("频段")
x(7) = rs("主设备类型")
x(8) = rs("设备代维公司")
x(9) = rs("TRU_MO")
x(10) = rs("TRU_STS")
x(11) = rs("T完好率")
x(12) = rs("定义信道")
x(13) = rs("可用信道")
x(14) = rs("话务量")
x(15) = rs("F话务量")
x(16) = rs("H话务量")
x(17) = rs("平均分配PDCH")
x(18) = rs("混合话务量")
x(19) = rs("STRU数")
x(20) = rs("配置EPDCH数")
x(21) = rs("EPDCH分配数")
x(22) = rs("EPDCH复用度")
x(23) = rs("统计时段数")
x(24) = rs("平均混合话务量")

ActiveWorkbook.Sheets(2).Cells(j, 1) = Mid(x(0), 1, 6)
ActiveWorkbook.Sheets(2).Cells(j, 2) = Mid(x(1), 1, 8)

For q = 1 To 10 '每次从数据库中取出一行，字段“cell”列的数据就同A1：A10进行比较，如果相同K=1，那么输出到表格里
If ActiveWorkbook.Sheets(2).Cells(q, 1) = x(3) Then
k = 1
Else
k = 0
End If
Next q
If k = 1 Then
For m = 3 To 25

ActiveWorkbook.Sheets(2).Cells(j, m) = x(m - 1)

Next m
End If

j = j + 1

'读取数据库下一条信息
rs.MoveNext

Loop

rs.Close

End Function