原创函数操作数据库查询、修改、删除、插入高效

池盛龙

以下讲解以SQLite数据库为例
新手请注意，先引用ADO且将连接字符串改为你的
全局变量声明【自定义函数及变量声明代码放置模块中】

1. Public cn As New ADODB.Connection
   
2. Public RS As New ADODB.Recordset
   
3. Public strCn As String, strSQL As String
   
4. Public arr, brr  '用于查询结果存储数据arr,用于存储标题brr

复制代码

查询数据库

1. Public Function XSQL(SQL As String, S As Boolean, dx As Object)
   
2. '参数 [语句,是否,赋值位置]
   
3. XSQL = False
   
4. On Error GoTo ErrHandler
   
5. ' 定义SQLite3连接字符串
   
6. strCn = "Driver={SQLite3 ODBC Driver};Database=" & ThisWorkbook.Path & "\CHISHENGLONG.db"
   
7. cn.Open strCn
   
8. Set RS = cn.Execute(SQL)
   
9. ReDim brr(0, RS.Fields.Count - 1)
   
10. Dim f As Integer '获取标题
    
11. For f = 0 To RS.Fields.Count - 1
    
12. brr(0, f) = RS.Fields(f).Name
    
13. Next
    
14. If RS.BOF = False Then '有数据记录时执行
    
15. arr = RS.GetRows '获取结果且装置成二维数据
    
16. 'arr = VBt.Transpose(RS.GetRows) '获取结果且装置成二维数据
    
17. If S = True Then
    
18. ' CopyFromRecordset 或GetRows后，记录集指针已经移到了EOF，这时如果想继续使用该记录集，应该把其指针再移回第一条
    
19. RS.MoveFirst '指针移第一行 '
    
20. dx.CopyFromRecordset RS
    
21. End If
    
22. Else
    
23. Set arr = Nothing
    
24. End If
    
25. cn.Close ' 关闭连接
    
26. XSQL = True
    
27. Exit Function
    
28. ErrHandler:
    
29. cn.Close
    
30. MsgBox " 系统错误 " & Err.Number & " ： " & Err.Description
    
31. Exit Function
    
32. End Function

复制代码

插入、删除、更新数据库

1. Public Function SSQL(SQL As String)
   
2. '参数 [语句]
   
3. SSQL = False
   
4. On Error GoTo ErrHandler
   
5. ' 定义连接字符串
   
6. strCn = "Driver={SQLite3 ODBC Driver};Database=" & ThisWorkbook.Path & "\CHISHENGLONG.db"
   
7. cn.Open strCn
   
8. Set RS = cn.Execute(SQL)
   
9. SSQL = True
   
10. cn.Close
    
11. Exit Function
    
12. ErrHandler:
    
13. cn.Close
    
14. MsgBox " 系统错误 " & Err.Number & " ： " & Err.Description
    
15. Exit Function
    
16. End Function

复制代码

字段转化函数

1. Public Function ZSQL(Zd As String) As Integer  '字段名转列数
   
2. Dim Y As Integer
   
3. For Y = 0 To UBound(brr, 2) '数组列数
   
4. If brr(0, Y) = Zd Then
   
5. ZSQL = Y
   
6. End If
   
7. Next
   
8. End Function

复制代码

下面是使用例子
一、查询语句

1. Sub 查询()
   
2. If XSQL("SELECT  *  FROM  用户管理 ", False, Nothing) = False Then MsgBox "该操作未处理成功,请重新操作一次！", vbExclamation: Exit Sub
   
3. If TypeName(arr) = "Nothing" Then MsgBox "查无数据！", vbExclamation: Exit Sub    '判断数组是否为空
   
4. 
   
5. MsgBox UBound(arr, 1) + 1 '总行数
   
6. MsgBox UBound(arr, 2) + 1 '总列数
   
7. MsgBox arr(ZSQL("用户名"), 0) '获取查询出的结果,字段为用户名的第一行信息。参数【字段名,行数】
   
8. End Sub

复制代码

一、插入删除更新语句（下面只列出插入示例，删除，更新语句雷同，这里不做其他说明）

1. Sub 插入()
   
2. '删除，更新语句雷同，这里不做其他说明
   
3. If SSQL("INSERT INTO 用户管理 (用户名,密码)VALUES ('用户名','密码')") = False Then MsgBox "该操作未处理成功,请重新操作一次！", vbExclamation: Exit Sub
   
4. End Sub
   

复制代码

注：大伙觉得不错请帮忙顶帖谢谢，创作不易。

WPS仓库出入库管理软件表格

EXCEL仓库出入库管理软件表格

池盛龙