Excel VBA 连接数据库代码

VBA 连接SQLSERVER 数据库(要引用ADO)

Public Sub hello()
   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  '定义记录集对象，保存数据表
Dim strCn As String, strSQL As String '字符串变量

strCn = "Provider=sqloledb;Server=localhost;Database=pubs;Uid=sa;Pwd=sa"
strSQL = "select  job_id,job_desc from  jobs"
cn.Open strCn   '与数据库建立连接，如果成功，返回连接对象cn
rs.Open strSQL, cn  '执行strSQL所含的SQL命令，结果保存在rs记录集对象中

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

cn.Close  '关闭数据库链接,释放资源
ActiveWorkbook.SaveAs "D:/aa.xls"

End Sub

 

 

 

VBA 连ORACLE  代码（要配数据源和引用ADO）

Public Sub getData()
 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  '定义记录集对象，保存数据表
Dim strCn As String, strSQL As String '字符串变量
Dim rNum As Integer

'strCn = "Provider=MSDAORA.1;Persist Security Info=TRUE;Data Source=INSITE,User Id=emapc,Password=empac"
strSQL = "SELECT TO_CHAR(SYSDATE,'YYYY-MM-DD') a,COUNT(*) b FROM TSW_NOUN_QUALIFIERS WHERE qual<>'默认' AND TO_CHAR(LAST_MOD_DATE,'YYYY-MM-DD')=TO_CHAR(SYSDATE,'YYYY-MM-DD')"
strCn = "Provider=MSDASQL.1;Persist Security Info=False;User ID=EMPAC;password=empac;Data Source=insite;Extended Properties=" & "DSN=insite;UID=EMPAC;DBQ=INSITE ;DBA=W;APA=T;EXC=F;FEN=T;QTO=T;FRC=10;FDL=10;LOB=T;RST=T;GDE=F;FRL=F;BAM=IfAllSuccessful;MTS=F;MDI=F;CSR=F;FWC=F;PFC=10;TLO=0"
cn.Open strCn   '与数据库建立连接，如果成功，返回连接对象cn
rs.Open strSQL, cn  '执行strSQL所含的SQL命令，结果保存在rs记录集对象中

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

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

End Sub