这些代码有如下优势:
•无需任何配置。在VBA中新建模块,并把代码复制转帖过去即可使用。
•有以下函数:执行数据库语句、查询数据库、结果复制到单元格(Excel中最常用)、将Excel表格上传到数据库。基本覆盖Excel中对数据库的常用 *** 作。
•会在立即窗口显示数据库错误信息,方便查错。
•在数据库连接字符串字典中配好数据库连接信息后,数据库访问时可直接使用配好的链接字符串。
具体的函数用法已经写在下面代码注释里。简单描述一下:
•dqQueryToArray(sql, connection_string) 查询数据库,返回一个二维数组
•dbQueryOne(sql, connection_string) 查询数据库,返回单个变量。
•dbQueryToCell(sql, range, connection_string, withHeader) 查询数据库后,将结果显示在range开始的区域中;withHeader控制是否显示列名。
•dbExec(sql, necction_string) 执行数据库语句;无返回值
•dbInsertRange(table, range, connection_string, is_empty) 将本Excel文件的range区域里的数据插入到数据库的表table。其中is_empty控制在上传数据前是否清空table的原数据。
其它就看一下代码吧:
' EXCEL的ADO数据库 *** 作函数库
' 这些代码应该放在Excel的VBA模块中,类模块的名字为database,并以以下形式引用:
'
' res = dbQueryToArry(sql, connection_string)
' ' 返回sql的查询结果,结果为一个二维数组
' res = dbQueryOne(sql, connection_string)
' ' 返回sql的查询结果,但只返回第一个数据(相当于数据库查询结果的左上角那个数据)
' dbQueryToCell sql, save_to_range, connection_string, withHeader
' ' 将sql的查询结果直接写入到以save_to_range开头的单元格区域中
' ' withHeader控制是否复制表头,默认为true(复制表头)
'
' 其中参数sql为数据库查询语句,connection_string为数据库连接字符串。
'
' 比如要连接SQL数据库,并已经设置ODBC,连接字符串为:
' "Provider=MSDASQLDSN=odbc_nameUID=usernamePWD=passworddatabase=database_name"
' 如果未设置ODBC,连接字符串为:
' "driver={SQL Server}server=service_name_or_ipuid=usernamepwd=passworddatabase=database_name"
' 其中最后面的database变量可省略。对于SQL Server,推荐使用后一种方法。
'
' 如果数据来源为Excel文件,connection_string参数可省略
'
' 其它功能:内置数据库的连接字符串、查询存储过程
'
' Author: zhang@zhiqiang.org, 2014-03-01 v4
' url: http://zhiqiang.org/blog/it/excel-vba-database-functions.html
Private sqlDict As Object ' 缓存数据
Private cnn As Object, rst As Object, lastConn As String
Private Sub dbInitialize()
If Not sqlDict Is Nothing Then Exit Sub
Set sqlDict = CreateObject("scripting.Dictionary")
lastConn = ""
' 在这里可以缓存一些常用的数据库信息,这样在查询数据库时可以直接调用
' 比如dbQueryToArry(sql, "this")
With sqlDict
.Add "SQL服务器", _
"Provider=MSDASQLDSN=odbc_nameUID=usernamePWD=passworddatabase=database_name"
.Add "SQL服务器(无需配置ODBC)", _
"driver={SQL Server}server=ipuid=usernamepwd=passworddatabase=database_name"
.Add "this", "Provider=Microsoft.ACE.OLEDB.12.0Data Source=" &ThisWorkbook.FullName &_
"Extended Properties=Excel " &Application.Version &""
End With
End Sub
' 查询数据库,返回RecordSet对象
' sql: 数据库查询语句
' sqlConnectString: 数据库连接信息,或者直接指定数据库,比如"Wind"、"JYDB"等,
' 利用内设的数据库连接信息
Public Function dbQuery(sql As String, _
Optional ByVal sqlConnectString As String = "this") As Object ' ADODB.Recordset
dbConnectSQL sqlConnectString
On Error GoTo errorhander
rst.Open sql, cnn
Set dbQuery = rst
errorhander:
dbDisplayError sql
End Function
' 查询数据库,返回一个数组
' sql: 数据库查询语句
' sqlConnectString: 数据库连接信息,或者直接指定数据库,比如"Wind"、"JYDB"等,
' 利用内设的数据库连接信息
Public Function dbQueryToArray(sql As String, _
Optional ByVal sqlConnectString As String = "this")
dbConnectSQL sqlConnectString
On Error GoTo errorhander
rst.Open sql, cnn
dbQueryToArray = rst.GetRows(10000000)
errorhander:
DisplayError sql
End Function
' 查询数据库,返回单个数值
' sql: 数据库查询语句
' sqlConnectString: 数据库连接信息,或者直接指定数据库,比如"Wind"、"JYDB"等,
' 利用内设的数据库连接信息
Public Function dbQueryOne(sql As String, _
Optional ByVal sqlConnectString As String = "this")
dbConnectSQL sqlConnectString
On Error GoTo errorhander
rst.Open sql, cnn
dbQueryOne = rst.Fields.Item(0).value
errorhander:
dbDisplayError sql
End Function
' 查询数据库,返回单个数值
' sql: 数据库查询语句
' sqlConnectString: 数据库连接信息,或者直接指定数据库,比如"Wind"、"JYDB"等,
' 利用内设的数据库连接信息
Public Function dbQueryToCell(sql$, Optional rng As Excel.Range, _
Optional ByVal sqlConnectString$ = "this", _
Optional withHeader As Boolean = True)
On Error GoTo error_handler
dbConnectSQL sqlConnectString
rst.Open sql, cnn
Set rng = rng.Cells(1, 1)
If withHeader = True Then
Dim i As Long
For i = 0 To rst.Fields.Count - 1
rng.Offset(0, i).value = rst.Fields(i).Name
Next
rng.Offset(1, 0).CopyFromRecordset rst
Else
rng.CopyFromRecordset rst
End If
error_handler:
dbDisplayError sql
End Function
' 执行任意数据库语句,无返回结果。如需返回结果,请使用Query、QueryOne、QueryToCell等函数
' sql: 数据库查询语句
' sqlConnectString: 数据库连接信息,或者直接指定数据库,比如"Wind"、"JYDB"等,利用内设的数据库连接信息
Sub dbExec(ByVal sql As String, _
Optional ByVal sqlConnectString As String = "this")
dbConnectSQL sqlConnectString
On Error GoTo errorhander
cnn.Execute sql
errorhander:
dbDisplayError sql
End Sub
' 这个函数用来上传一个Excel区域到数据库,数据表必须事先建好,并且包括Excel区域的第一行
' Database.InsertRange(table, rng, sqlConnectString, isEmpty)
' table:Excel数据将上传到这个表内
' rng: 将被上传的Excel区域
' sqlConnectString: 数据库连接字符串
' isEmpty: 是否清空原有表格数据
Public Function dbInsertRange(table$, rng As Excel.Range, Optional ByVal sqlConnectString$ = "this", _
Optional isEmpty As Boolean = False)
dbConnectSQL sqlConnectString
On Error Resume Next
If isEmpty Then dbExec "delete from " &table, sqlConnectString$
Dim r As Long, sqlHead$, i As Long
' 首选根据isEmpty选项,删除原表内所有数据
For i = 1 To rng.Columns.Count
sqlHead = sqlHead &",[" &rng.Cells(1, i) &"]"
Next i
' 其次,依次拆入每行
' 目前每一行都需运行一个SQL语句,效率较低,如果数据量较大,可能会引起Excel死机
sqlHead = "insert into " &table &" (" &mid(sqlHead, 2, 10000000) &") values "
For r = 2 To rng.rows.Count
Dim sql$
sql = ""
For i = 1 To rng.Columns.Count
Dim v
v = rng.Cells(r, i).value()
If IsError(v) Then v = ""
If IsDate(v) Then
sql = sql &",'" &Format(v, "yyyy-mm-dd") &"'"
ElseIf v <>"" And IsNumeric(v) Then
sql = sql &"," &v
Else
sql = sql &",'" &v &"'"
End If
Next i
dbExec sqlHead &" (" &mid(sql, 2, 1000000) &")", sqlConnectString$
Next r
End Function
' 查询存储过程,返回的是ADODB.RecordSet对象
Public Function dbQueryStoredProc(procName$, para, _
Optional ByVal sqlConnectString As String = "this", _
Optional returnPara As Boolean = True) As Object 'ADODB.Recordset
On Error GoTo errorhander
dbConnectSQL sqlConnectString
With com
.ActiveConnection = cnn
.CommandType = adCmdStoredProc
.CommandText = procName
' 获取存储过程的参数定义
.Parameters.Refresh
' 如果存在输出参数,则删除它,默认第一个为输出参数
On Error Resume Next
If returnPara Then .Parameters.Delete 0
' 设置输入参数的值
If IsArray(para) Then
Dim i
For i = 0 To UBound(para)
.Parameters.Item(i).value = para(i)
Next i
End If
' 改变输入参数大小
Dim tmpp
For Each tmpp In .Parameters
tmpp.Size = 255
Next tmpp
' 获取参数返回值
Set dbQueryStoredProc = .Execute()
End With
errorhander:
DisplayError sql
End Function
Private Sub dbClose()
' 当类被注销时,断开数据库连接
On Error Resume Next
If cnn.State <>0 Then cnn.Close
End Sub
' 连接数据库
' 此处首先检查cnn是否已经连接到想要连接的数据库,如果已经连接,将不产生任何 *** 作
' 本Database对象在对象存续过程中,不会主动断开;
' 只有在对象注销之时,才断开数据库,如需断开数据库连接,请set db = nothing
Private Function dbConnectSQL(ByVal sqlConnectString$) As String
On Error Resume Next
Call dbInitialize
If sqlDict.Exists(LCase(sqlConnectString)) Then
sqlConnectString = sqlDict.Item(LCase(sqlConnectString))
End If
If rst Is Nothing Then Set rst = CreateObject("ADODB.Recordset")
If cnn Is Nothing Then Set cnn = CreateObject("ADODB.Connection")
If cnn.State <>1 Or lastCnn <>sqlConnectString Then
cnn.Close
Set cnn = Nothing
Set cnn = CreateObject("ADODB.Connection")
cnn.Open sqlConnectString
lastConn = sqlConnectString
End If
dbConnectSQL = sqlConnectString
End Function
' 显示查询数据库过程中出现的错误信息,信息被显示在立即窗口。
Private Sub dbDisplayError(sql$)
Dim e
If cnn.Errors.Count >0 Then
Debug.Print cnn.Errors.Count &" errors found when exec """ &sql &""""
For Each e In cnn.Errors
Debug.Print "Error info: " &e.description &" Source: " &e.Source
Next e
End If
End Sub
*** 作步骤如下:准备数据:在excel中构造出需要的数据
2.将excel中的数据另存为文本文件(有制表符分隔的)
3.将新保存到文本文件中的数据导入到pl*sql中
在pl*sql中选择tools-->text
importer,在出现的窗口中选择"data
from
textfile",然后再选择"open
data
file",
在d出的文件选择框中选中保存有数据的文本文件,此时将会看到data
from
textfile中显示将要导入的数据
4.在configuration中进行如下配置
注:如果不将"name
in
header"勾选上会导致字段名也当做记录被导入到数据库中,从而导致数据错误
5.点击data
to
oracle,选择将要导入数据的表,并在fields中将文本中的字段与表中的字段进行关联
6.点击import按钮进行导入
7.查看导入的数据
ok,至此数据导入成功。
如果我们要在Excel表格中实现自动实时更新数据,要怎样 *** 作呢?下面就来给大家分享 *** 作方法。
工具/材料Excel2010
首先,打开Excel2010,在要显示更新数据的单元格处点击,再点击插入函数按钮fx。
d出插入函数对话框,接下来选择类别为全部,在下方的列表框中找到Lookup函数,点击确定。
选择第二种格式,点击确定,d出函数参数设置界面。
在第一个参数框中输入9E+307,这是一个科学记数法,意思是9*10^307。代表很大的数。
在第二个参数框中输入要检测的数据区域,比如第2行中的所有单元格,则输入2:2,确定。
确定后,公式值显示为错误值,没关系,在第二行中任意一单元格中输入数字,公式值就实时更新了。
欢迎分享,转载请注明来源:内存溢出
评论列表(0条)