如何更新Excel的数据库查询函数库

如何更新Excel的数据库查询函数库,第1张

更新一下之前写的Excel的数据类,将其改成函数的形式,调用更简单(省却了生成类实例的步骤)。现在这个代码在工作中用了一年多,已经比较健壮。若有问题,请留言指出或与我联系。

这些代码有如下优势:

•无需任何配置。在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,确定。

确定后,公式值显示为错误值,没关系,在第二行中任意一单元格中输入数字,公式值就实时更新了。


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/sjk/10067727.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-04
下一篇 2023-05-04

发表评论

登录后才能评论

评论列表(0条)

保存