「代码」EXCEL VBA操作ACCESS数据库，获取表头字段，SQL查询语句自定义函数【提高篇】
文摘
教育
2024-11-02 00:00
江苏
1、在工作表“操作”里，命令按钮点击事件，调用相应过程：Dim sql As String, tbl As String
Private Sub CmdFields1_Click() Dim tbTitle() Dim sql As String sql = "select top 1 * from tb员工" tbTitle = getFields(sql) With Sheet1 .UsedRange.Clear .Range("A1").Resize(1, UBound(tbTitle) + 1) = tbTitle End With MsgBox "Done!"End Sub
Private Sub CmdInsert_Click() Dim sql As String '//sql语句，插入新记录 tbl = "tb员工" If IsValueExists(tbl, "姓名", "王五") Then MsgBox "已存在【王五】！" Exit Sub End If sql = "Insert Into tb员工 (姓名, 出生日期, 部门, 住址) " & _ "VALUES ('王五', #1985-11-19#, '财务部', '江苏省南京市中山路1019号')" Call ExecuteSQL(sql) MsgBox "Done!"End Sub
Private Sub CmdQuery4_Click() Dim sql As String Dim arr() tbl = "tb员工" If Not IsValueExists(tbl, "姓名", "王五") Then MsgBox "不存在【王五】！" Exit Sub End If sql = "select * from tb员工 Where 姓名='王五'" arr = getData(sql) Sheet1.UsedRange.Clear Sheet1.Cells(1, 1).Resize(1, UBound(arr) + 1) = Application.Transpose(arr) MsgBox "Done!" Sheet1.Activate End Sub
Private Sub CmdQuery5_Click() MsgBox IsTableEmpty("tb员工") End Sub
Private Sub CmdDelete2_Click() tbl = "tb员工" sql = "Delete * from " & tbl & " Where 姓名='王五' " Call ExecuteSQL(sql) MsgBox "Done!"End Sub
2、在myModule1101里，定义变量，OpenConnection过程，打开指定数据库连接，ExecuteSQL自定义过程，执行SQL语句，IsTableEmpty，判断表是否有记录，getData，把查询结果存到数组：Dim strCnn As StringPublic conn As ObjectPublic rs As ObjectPublic dbs As StringSub OpenConnection(ByVal dbs As String, Optional ByVal psw As String = "")
'//获取数据库连接字符串 strCnn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbs Set conn = CreateObject("ADODB.Connection") '// 打开数据库链接 conn.Open strCnnEnd Sub
Sub ExecuteSQL(sql As String) '//执行SQL语句 dbs = ThisWorkbook.Path & "\DataBase1101.accdb" Call OpenConnection(dbs) conn.Execute (sql) conn.Close Set conn = NothingEnd Sub
Function IsTableEmpty(tbl As String) As Boolean '//检查表格是否有记录 Dim arr() Dim sql As String '//数据库 dbs = ThisWorkbook.Path & "\DataBase1101.accdb" Set rs = CreateObject("ADODB.Recordset") Call OpenConnection(dbs) sql = "select count(*) from " & tbl Set rs = conn.Execute(sql) arr = rs.GetRows IsTableEmpty = arr(0, 0) rs.Close Set rs = Nothing conn.Close Set conn = NothingEnd Function
Function getData(sql As String) '//获取查询结果，存到数组 'On Error Resume Next '//数据库 dbs = ThisWorkbook.Path & "\DataBase1101.accdb" Set rs = CreateObject("ADODB.Recordset") Call OpenConnection(dbs) Set rs = conn.Execute(sql) getData = rs.GetRows rs.Close Set rs = Nothing conn.Close Set conn = NothingEnd Function
3、在myModule1101里，getFields过程，参数sql，取得指定SQL语句查询结果的表头字段，IsValueExists，判断一个表中，指定字段是否存在某个值：Function getFields(sql As String) '//取得一个SQL查询语句的所有表头字段 Dim arr() Dim i As Integer Dim fieldsCount As Integer Set rs = CreateObject("ADODB.Recordset") '//数据库 dbs = ThisWorkbook.Path & "\DataBase1101.accdb" '//打开数据库连接 Call OpenConnection(dbs) '//执行查询 Set rs = conn.Execute(sql) '//把字段写入数组 fieldsCount = rs.Fields.Count ReDim arr(fieldsCount - 1) For i = 0 To fieldsCount - 1 arr(i) = rs.Fields(i).Name Next getFields = arr rs.Close Set rs = Nothing conn.Close Set conn = NothingEnd Function
Function IsValueExists(tbl As String, Field As String, currValue) As Boolean Dim sql As String Dim arr() sql = "select count(*) from " & tbl & " where " & Field & "= '" & currValue & "'" arr = getData(sql) If arr(0, 0) > 0 Then IsValueExists = True Else IsValueExists = False End If End Function
![]()
| 安利小店
安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！ |
![]()
| 合谷医疗
合谷医疗专攻各种疑难杂症，尤其擅长抑郁症、焦虑失眠、儿童神经发育异常、多动症、自闭孤独症、腰颈椎疾病治疗，可谓神乎其技！体验过的直呼早点来就好了！ |
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
