|
|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
最近经常搞数据库导表，干脆把功能封装了一个函数，也许用着不如手写方便，但是至少代码优雅了一点
- Function SQLreturn(SQLlinkStr As String, SQLstr As String, KeyArr As Variant, RecordArr As Variant)
- '/******************************************/
- '/参数列表： 1.SQL连接字符串 SQLlinkStr
- '/2.SQL语句 SQLstr
- '/3.提取字段数组 KeyArr(一维数组）
- '/4.记录集数组 RecordArr（二维数组）
- '/
- '/功能说明：
- '/该函数是为了操作数据库，需要提供以上几个参数，返回值就是记录集数组，请自行选择写入单元格的地址
- '/*****************************************/
- '/1.连接字符串示例
- 'strCn = "Driver={MySQL ODBC 8.0 Unicode Driver};Server=192.168.1 139;DB=数据库名;UID=用户名;PWD=密码;OPTION=3;" 'mysql示例
- 'strCn = "Driver={Oracle in OraClient11g_home1};Dbq=TNS服务名;Uid=数据库登录账户;Pwd=数据库登录密码;" 'Oracle示例
- 'strCn = "Provider=SQLOLEDB;Server=192.168.1.69;Database=数据库名;Uid=用户名;Pwd=密码" 'SqlServer示例
-
- '/2.SQL语句示例
- 'SQL语句可以直接嵌入任意变量，例如
- 'Sql = "SELECT ZYH,ZYHM,BRXM,RYSJ WHERE ZYH='" & textbox1.Value & "' AND TO_CHAR(RYSJ,'YYYY') = '" & textbox2.Value & "'"
-
- '/3.提取字段数组
- 'Dim Arr(1 To 10) As Variant
- 'For i = 1 To 10
- ' Arr(i) = i
- 'Next i
- '例如：
- 'Arr(1) = "姓名"
- 'Arr(2) = "年龄"
- 'Arr(3) = "入院日期"
- 'Arr(4) = "入院诊断"
- '
- '/4.记录集数组，提取字段有几个，二维就定义几个
- 'Dim Arr(1 To 10,1 to 4) As Variant
-
-
- '---------------------------------------------------------------------------------------------------------------------------------------------
- '函数正文
- '---------------------------------------------------------------------------------------------------------------------------------------------
-
- '参数定义
- Dim strCn As String '定义数据库连接字符串，对应参数1
- Dim strSQL As String '定义数据库SQL字符串,对应参数2
- Dim myKeyArr As Variant '定义提取关键字数组，对应参数3
- Dim myRecordArr As Variant '定义记录集数组，对应参数4
-
- '参数赋值
- strCn = SQLlinkStr '定义数据库链接字符串
- strSQL = SQLstr '定义SQL语句
- myKeyArr = KeyArr '定义提取关键字数组
- myRecordArr = RecordArr '定义记录集数组
-
- '创建数据库连接对象————————————————————————————————————————————————————————————————————————————————————————————
- 'Application.StatusBar = "连接数据库"
- Set cn = CreateObject("Adodb.Connection")
- Set rs = CreateObject("Adodb.Recordset")
-
- '建立数据库的连接——————————————————————————————————————————————————————————————————————————————————————————————
- cn.Open strCn '与数据库建立连接，如果成功，返回连接对象cn
- rs.Open strSQL, cn '执行strSQL所含的SQL命令，结果保存在rs记录集对象中
-
-
- '使用数组存储记录集—————————————————————————————————————————————————————————————————————————————————————————————
- 'Application.StatusBar = "获取数据成功，开始写入工作表"
- i = 1
- Do While Not rs.EOF '当数据指针未移到记录集末尾时，循环下列操作
- '把数据依次写入记录集数组，
- For j = 1 To (UBound(myKeyArr) - LBound(myKeyArr) + 1)
- myRecordArr(i, j) = rs(myKeyArr(j)) '用关键字数组中所有的关键字获取得到的字段
- Next j
- rs.MoveNext '把指针移向下一条记录
- i = i + 1 'i加1，准备把下一记录相关字段的值保存到工作表的下一行
- Loop '循环
- '将数组复制到单元格——————————————————————————————————————————————————————————————————————————————————————————————
- 'Set arrRecord = Nothing
- rs.Close '关闭记录集
- cn.Close '关闭数据库链接,释放资源
- '调整结果集数组的大小,去掉空值
- If i > 1 Then
- myRecordArr = Application.Transpose(myRecordArr)
- ReDim Preserve myRecordArr(1 To 2, 1 To i - 1)
- myRecordArr = Application.Transpose(myRecordArr)
- End If
- SQLreturn = myRecordArr
- End Function
以下是一个简单的调用示例：
- Sub test()
-
- '/******************************************/
- '/参数列表： 1.SQL连接字符串 SQLlinkStr
- '/2.SQL语句 SQLstr
- '/3.提取字段数组 KeyArr,必须为字符串数组，长度等于需要的关键字个数
- '/4.记录集数组 RecordArr,必须为二维数组
- '/
- '/功能说明：
- '/该函数是为了操作数据库，需要提供以上几个参数，返回值就是记录集数组，请自行选择写入单元格的地址
- '/所有参数都必须预定义类型
- '/*****************************************/
-
- Dim KeyArr(1 To 2) As Variant
- Dim RecordArr(1 To 30, 1 To 2) As Variant
- Dim SQLlinkStr As String
- Dim myStr As String
-
- SQLlinkStr = "Driver={Oracle in OraClient11g_home1};Dbq=数据库名称;Uid=用户名;Pwd=密码;"
- myStr = "select jzxh as 数量,kssj as 时间 from ys_mz_jzls where jzzt = '9' and to_char(kssj, 'yyyymmdd') = '20190309' and ksdm in (142)"
-
- '和上面需要提取的关键字对应，设置关键字数组
- KeyArr(1) = "数量"
- KeyArr(2) = "时间"
-
- '缓存数组用于存储结果
- tmpArr = SQLreturn(SQLlinkStr, myStr, KeyArr, RecordArr)
-
- '写入时通过缓存数组的第一维长度确定填充的行数
- Sheet1.Range("A1:B" & UBound(tmpArr)) = tmpArr
- End Sub
如果对VBA连接数据库有疑问，可以参考我的博客文章：
Excel VBA 如何连接数据库
|
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2020-1-10 21:57
楼主