VBA数据库连接代码(自己编制成功)

Private Sub CommandButton1_Click()

Dim i As Integer, j As Integer, sht As Worksheet 'i,j为整数变量；sht 为excel工作表对象变量，指向某一工作表

Dim cn As Object '定义数据链接对象，保存连接数据库信息

Dim rs As Object '定义记录集对象，保存数据表

Set cn = CreateObject("ADODB.Connection") '创建数据链接对象

Set rs = CreateObject("ADODB.RecordSet") '创建记录集对象

Dim strCn As String, strSQL As String '字符串变量

strCn = "Provider=sqloledb;Server=GuilinHu-PC\HuglSQLSEVER;Database=Hugl;U id=sa;Pwd=HGL102643lch;" '定义数据库链接字符串

’Sever =服务器名称；Database =数据库名称,Uid =sa ； Pwd = 以sa身份登录数据库的密码

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

strSQL = "select 姓名,性别,年龄 from 个人信息" '定义SQL查询命令字符串cn.Open strCn '与数据库建立连接，如果成功，返回连接对象cn

rs.Open strSQL, cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中

i = 1

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

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

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

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

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

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

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

Loop '循环

rs.Close '关闭记录集，至此，程序将把某数据表的字段1和字段2保存在excel工作表sheet1的第1、2列，行数等于数据表的记录数

End Sub

'工具->引用->Microsoft ActiveX Date Object 2.0

Public Sub SaveData()

Dim Cnn As ADODB.Connection

Dim SQL As String

Set Cnn = New ADODB.Connection

'建立于数据库的链接

'这里根据你的实际值修改

ConnectionString = "Driver=SQL Server;Server=服务器名

称;Database=数据库;Uid=账号;Pwd=密码;"

With Cnn

.Provider = "SQLOLEDB"

.ConnectionString = "Driver=SQL Server;Server=mxb\sqlex press;Database=test;Uid=sa;Pwd=xiaoma;"

.Open

End With

'保存数据

r = Range("A65534").End(xlUp).Row

For i = 1 To r

'拼sql

SQL = "insert into T values('"& Cells(i, 1) & "','"& Cells(i, 2) & "',"& Cells(i, 3) & ")"

Cnn.Execute SQL

Next

Cnn.Close

Set Cnn = Nothing

MsgBox "保存成功"

End Sub

上面是通过VBA,插入数据到数据库,下面是从SQL查询Excel,然后直接

insert into到数据库,也可以用数据库导入向导

--查询excel2007

select * from OpenDataSource('Microsoft.ACE.OLEDB.12.0', 'Data Source=D:\2007.xlsx;Extended Properties="Excel 12.0;HDR=Yes;IME X=1"')...[Sheet1$]

--查询excel2003

select * from OpenDataSource( 'Microsoft.Jet.OLEDB.4.0','Data S ource="D:\2003.xls";Extended properties=Excel 5.0')...[Sheet1$]

;向数据库中写入

Sub ReturnSQLrecord()

Dim i As Integer, sht As Worksheet

'定义数据链接对象，保存连接数据库信息

'使用ADODB，须在菜单的Tools->References中添加引用“Microsoft ActiveX Data Objects library 2.x”

Dim cn As New ADODB.Connection

Dim strCn As String, strSQL As String

'定义数据库链接字符串,Server=服务器名称或IP地址(本地可填写“.”);Database=数据库名称;Uid=用户登录名;Pwd=密码

strCn = "Provider=sqloledb;Server=.;Database=pubs;Uid=sa;Pwd=sa;"

'清空定义的变量

strSQL = ""

'与数据库建立连接，如果成功，返回连接对象cn

cn.Open strCn

Set sht = ThisWorkbook.Worksheets("sheet1")

For i = 2 To 6

'构造SQL命令串,对标识列job_id执行插入操作时，要设置表的

IDENTITY_INSERT为打开，否则会插入失败

strSQL = strSQL & "SET IDENTITY_INSERT dbo.jobs ON;insert into dbo.jobs(job_id,job_desc,min_lvl,max_lvl) values(" _

& sht.Cells(i, 1) & "," & CStr(sht.Cells(i, 2)) & "," & sht.Cells(i, 3) & "," & sht.Cells(i, 4) & ") ;"

Next

'执行该SQL命令串，如果SQL命令没有错误，将在数据库中添加5个记录;也可以用rs.open strSQL,cn 执行

cn.Execute strSQL

'关闭数据库链接,释放资源

cn.Close

End Sub

;从数据库读取

Sub ReturnSQLrecord()

'sht 为excel工作表对象变量,指向某一工作表

Dim i As Integer, sht As Worksheet

'定义数据链接对象，保存连接数据库信息

'使用ADODB，须在菜单的Tools->References中添加引用“Microsoft ActiveX Data Objects library 2.x”

Dim cn As New ADODB.Connection

'定义记录集对象，保存数据表

Dim rs As New ADODB.Recordset

Dim strCn As String, strSQL As String

'定义数据库链接字符串,Server=服务器名称或IP地址(本地可填写“.”);Database=数据库名称;Uid=用户登录名;Pwd=密码

strCn = "Provider=sqloledb;Server=NIKEY-980114BB0;Database=pubs;Uid=sa;Pwd =sa;"

'定义SQL查询命令字符串

strSQL = "select job_id, job_desc from dbo.jobs"

'与数据库建立连接，如果成功，返回连接对象cn

cn.Open strCn

'执行strSQL所含的SQL命令，结果保存在rs记录集对象中

rs.Open strSQL, cn

i = 1

'把sht指向当前工作簿的sheet1工作表

Set sht = ThisWorkbook.Worksheets("sheet1")

'当数据指针未移到记录集末尾时，循环下列操作

Do While Not rs.EOF

'把当前记录的job_id字段的值保存到sheet1工作表的第i行第1列

sht.Cells(i, 1) = rs("job_id")

sht.Cells(i, 2) = rs("job_desc")

'把指针移向下一条记录

rs.MoveNext

i = i + 1

Loop

'关闭记录集

rs.Close

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

End Sub