'自定义简单查询SQL赋值到数组
'Public JLH As Long '长整数变量;工作表记录所在行
'Public JLL As Long '长整数变量;工作表记录所在行
Function SQL_JDCX(F_Url As String, F_strSQL As String) As Variant
'F_Url '定义数据库链接字符串,连接方法、服务器名称、数据库名称、数据库账号、数据库密码
'F_strSQL As String '字符串变量sql语句字符串
Dim i
Dim j
Dim F_arr
Set cn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
On Error GoTo errmsg '出现错误转到标识
cn.Open F_Url '与数据库建立连接,如果成功,返回连接对象cn
rs.Open F_strSQL, cn, 1, 3 '执行strSQL所含的SQL命令,结果保存在rs记录集对象中
JLH = rs.RecordCount
JLL = rs.Fields.Count
'SQL记录 装入数组------------------------------------
ReDim F_arr(1 To JLH + 1, 1 To JLL)
rs.Movefirst
'表头赋值
For i = 0 To rs.Fields.Count - 1
F_arr(1, i + 1) = rs.Fields(i).Name '标题
Next
'记录赋值
For i = 1 To JLH
For j = 0 To rs.Fields.Count - 1
F_arr(i + 1, j + 1) = rs.Fields(j).Value '标题
Next
If i < JLH Then rs.MoveNext
Next
SQL_JDCX = F_arr
rs.Close '关闭记录集
cn.Close '关闭数据库链接,释放资源
errmsg: '出现错误执行标识后语句
If Err.Number <> 0 Then '出错执行,显示报错信息
MsgBox Err.Description, , "错误报告"
MsgBox "Err.Number " & Err.Number
End If
End Function
数组粘贴到excel工作表
'-------数组数据传入指定工作表位置
vs.Range(“A5”).Resize(JLH + 1, JLL) = arr