ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 619|回复: 14

[分享] 自己封装的VBA 连接数据库的函数

[复制链接]

TA的精华主题

TA的得分主题

发表于 2020-1-10 21:57 | 显示全部楼层 |阅读模式
最近经常搞数据库导表,干脆把功能封装了一个函数,也许用着不如手写方便,但是至少代码优雅了一点

  1. Function SQLreturn(SQLlinkStr As String, SQLstr As String, KeyArr As Variant, RecordArr As Variant)
  2.     '/******************************************/
  3.     '/参数列表: 1.SQL连接字符串 SQLlinkStr
  4.     '/2.SQL语句 SQLstr
  5.     '/3.提取字段数组 KeyArr(一维数组)
  6.     '/4.记录集数组 RecordArr(二维数组)
  7.     '/
  8.     '/功能说明:
  9.     '/该函数是为了操作数据库,需要提供以上几个参数,返回值就是记录集数组,请自行选择写入单元格的地址
  10.     '/*****************************************/
  11.     '/1.连接字符串示例
  12.     'strCn = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=192.168.1 139;DB=数据库名;UID=用户名;PWD=密码;OPTION=3;"  'mysql示例
  13.     'strCn = "Driver={Oracle in OraClient11g_home1};Dbq=TNS服务名;Uid=数据库登录账户;Pwd=数据库登录密码;"   'Oracle示例
  14.     'strCn = "Provider=SQLOLEDB;Server=192.168.1.69;Database=数据库名;Uid=用户名;Pwd=密码" 'SqlServer示例
  15.    
  16.     '/2.SQL语句示例
  17.     'SQL语句可以直接嵌入任意变量,例如
  18.     'Sql = "SELECT ZYH,ZYHM,BRXM,RYSJ WHERE ZYH='" & textbox1.Value & "' AND TO_CHAR(RYSJ,'YYYY') = '" & textbox2.Value & "'"
  19.    
  20.     '/3.提取字段数组
  21.     'Dim Arr(1 To 10) As Variant
  22.     'For i = 1 To 10
  23.     '   Arr(i) = i
  24.     'Next i
  25.     '例如:
  26.     'Arr(1) = "姓名"
  27.     'Arr(2) = "年龄"
  28.     'Arr(3) = "入院日期"
  29.     'Arr(4) = "入院诊断"
  30.     '
  31.     '/4.记录集数组,提取字段有几个,二维就定义几个
  32.     'Dim Arr(1 To 10,1 to 4) As Variant
  33.    
  34.    
  35.     '---------------------------------------------------------------------------------------------------------------------------------------------
  36.     '函数正文
  37.     '---------------------------------------------------------------------------------------------------------------------------------------------
  38.    
  39.     '参数定义
  40.     Dim strCn As String '定义数据库连接字符串,对应参数1
  41.     Dim strSQL As String '定义数据库SQL字符串,对应参数2
  42.     Dim myKeyArr As Variant '定义提取关键字数组,对应参数3
  43.     Dim myRecordArr As Variant '定义记录集数组,对应参数4
  44.    
  45.     '参数赋值
  46.     strCn = SQLlinkStr '定义数据库链接字符串
  47.     strSQL = SQLstr '定义SQL语句
  48.     myKeyArr = KeyArr '定义提取关键字数组
  49.     myRecordArr = RecordArr '定义记录集数组
  50.    
  51.     '创建数据库连接对象————————————————————————————————————————————————————————————————————————————————————————————
  52.     'Application.StatusBar = "连接数据库"
  53.     Set cn = CreateObject("Adodb.Connection")
  54.     Set rs = CreateObject("Adodb.Recordset")
  55.    
  56.     '建立数据库的连接——————————————————————————————————————————————————————————————————————————————————————————————
  57.     cn.Open strCn '与数据库建立连接,如果成功,返回连接对象cn
  58.     rs.Open strSQL, cn '执行strSQL所含的SQL命令,结果保存在rs记录集对象中
  59.    
  60.    
  61.     '使用数组存储记录集—————————————————————————————————————————————————————————————————————————————————————————————
  62.     'Application.StatusBar = "获取数据成功,开始写入工作表"
  63.     i = 1
  64.     Do While Not rs.EOF '当数据指针未移到记录集末尾时,循环下列操作
  65.         '把数据依次写入记录集数组,
  66.         For j = 1 To (UBound(myKeyArr) - LBound(myKeyArr) + 1)
  67.             myRecordArr(i, j) = rs(myKeyArr(j))     '用关键字数组中所有的关键字获取得到的字段
  68.         Next j
  69.         rs.MoveNext '把指针移向下一条记录
  70.         i = i + 1 'i加1,准备把下一记录相关字段的值保存到工作表的下一行
  71.     Loop '循环
  72.     '将数组复制到单元格——————————————————————————————————————————————————————————————————————————————————————————————
  73.     'Set arrRecord = Nothing
  74.     rs.Close '关闭记录集
  75.     cn.Close '关闭数据库链接,释放资源
  76.     '调整结果集数组的大小,去掉空值
  77.     If i > 1 Then
  78.         myRecordArr = Application.Transpose(myRecordArr)
  79.         ReDim Preserve myRecordArr(1 To 2, 1 To i - 1)
  80.         myRecordArr = Application.Transpose(myRecordArr)
  81.     End If
  82.     SQLreturn = myRecordArr
  83. End Function

复制代码


以下是一个简单的调用示例:
  1. Sub test()
  2.    
  3.     '/******************************************/
  4.     '/参数列表: 1.SQL连接字符串 SQLlinkStr
  5.     '/2.SQL语句 SQLstr
  6.     '/3.提取字段数组 KeyArr,必须为字符串数组,长度等于需要的关键字个数
  7.     '/4.记录集数组 RecordArr,必须为二维数组
  8.     '/
  9.     '/功能说明:
  10.     '/该函数是为了操作数据库,需要提供以上几个参数,返回值就是记录集数组,请自行选择写入单元格的地址
  11.     '/所有参数都必须预定义类型
  12.     '/*****************************************/
  13.    
  14.     Dim KeyArr(1 To 2) As Variant
  15.     Dim RecordArr(1 To 30, 1 To 2) As Variant
  16.     Dim SQLlinkStr As String
  17.     Dim myStr As String
  18.    
  19.     SQLlinkStr = "Driver={Oracle in OraClient11g_home1};Dbq=数据库名称;Uid=用户名;Pwd=密码;"
  20.     myStr = "select jzxh as 数量,kssj as 时间 from ys_mz_jzls  where jzzt = '9' and to_char(kssj, 'yyyymmdd') = '20190309' and ksdm in (142)"
  21.    
  22.     '和上面需要提取的关键字对应,设置关键字数组
  23.     KeyArr(1) = "数量"
  24.     KeyArr(2) = "时间"
  25.    
  26.     '缓存数组用于存储结果
  27.     tmpArr = SQLreturn(SQLlinkStr, myStr, KeyArr, RecordArr)
  28.    
  29.     '写入时通过缓存数组的第一维长度确定填充的行数
  30.     Sheet1.Range("A1:B" & UBound(tmpArr)) = tmpArr
  31. End Sub
复制代码
代码相对来说简短了一些,更容易把精力放到数据的处理上,而不用过分关注数据库连接的过程。

如果对VBA连接数据库有疑问,可以参考我的博客文章:
Excel VBA 如何连接数据库

TA的精华主题

TA的得分主题

发表于 2020-1-11 16:31 | 显示全部楼层
做适合自己使用的东西,不错,但上面存在一定问题,数组转置的位置

TA的精华主题

TA的得分主题

发表于 2020-1-11 16:45 | 显示全部楼层
有老师知道我用的wps等等查询表格内的数据库,找不到工程或者库,但有时又可以查询数据库,
我怎么设置呢,弃用wps?

TA的精华主题

TA的得分主题

发表于 2020-1-11 17:14 | 显示全部楼层
232670631 发表于 2020-1-11 16:45
有老师知道我用的wps等等查询表格内的数据库,找不到工程或者库,但有时又可以查询数据库,
我怎么设置呢 ...

本来WPS就是高仿的Office,存在兼容性很正常。

TA的精华主题

TA的得分主题

发表于 2020-1-11 17:35 | 显示全部楼层
我也学你模样,弄了个示例,你也参考参考,提一下意见

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-12 00:25 来自手机 | 显示全部楼层
microyip 发表于 2020-1-11 16:31
做适合自己使用的东西,不错,但上面存在一定问题,数组转置的位置

转置位置?可否详细说明?

TA的精华主题

TA的得分主题

发表于 2020-1-12 10:29 | 显示全部楼层
shandongdxl 发表于 2020-1-12 00:25
转置位置?可否详细说明?

可能你看我写的内容里有数组转置部分,里面有个注释你会留意到,就是SQL数据可能存在Null,那么Transpose就会出错,除此之外,Transpose也是有行数限制的

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-12 20:18 | 显示全部楼层
microyip 发表于 2020-1-12 10:29
可能你看我写的内容里有数组转置部分,里面有个注释你会留意到,就是SQL数据可能存在Null,那么Transpose ...

仔细想想,这个函数确实有很多问题,我还是手动实现转置吧= = ,RecordArr的第一维其实也是不确定的,没法在函数里限制为2.
搞个通用的东西真难。。。。。。。

TA的精华主题

TA的得分主题

发表于 2020-1-12 22:13 | 显示全部楼层
shandongdxl 发表于 2020-1-12 20:18
仔细想想,这个函数确实有很多问题,我还是手动实现转置吧= = ,RecordArr的第一维其实也是不确定的,没 ...

不是的,你这个做法,我很认同,你也已经做得很好,只是我提出一些思考给你参考而已。或者你也可以看看我写的,给点意见

TA的精华主题

TA的得分主题

 楼主| 发表于 2020-1-13 22:31 | 显示全部楼层
microyip 发表于 2020-1-12 22:13
不是的,你这个做法,我很认同,你也已经做得很好,只是我提出一些思考给你参考而已。或者你也可以看看我 ...

老实说,你回复的帖子里,我看不到内容
我是这么处理的,如果SQL结果为0,那么结果集数组长度为0,则不进行转置
就是感叹一下,不是说你在打击我;:P
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,每天学会一个新技能

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-4-7 06:11 , Processed in 0.080941 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表