ExcelVBA 操作 SQLite3 数据库实例分享

今天给大家分享用 ExcelVBA 操作轻便、快速、流行的数据库管理软件SQLite3，进行数据的增删改查。

一、新增数据

录入数据后，点击新增按钮

打开 sqlite3 数据库，可以看到新增的数据，如下图

VBA 代码

Sub Expenses_Insert_Click()

Dim sh1 As Worksheet

Dim strSQL As String, strCnn$

Dim i As Integer

Dim n As Integer

Dim arr()

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set sh1 = Sheets(1)

n = sh1.Range("A65536").End(xlUp).Row

If n < 2 Then

MsgBox "Nothing to insert!"

Exit Sub

End If

strCnn = "DRIVER={SQLite3 ODBC Driver};Database=E:\\mydb\\expenses.db;ReadOnly=False;"

cn.Open strCnn

arr = sh1.Range("A2:L" & n)

For i = 1 To UBound(arr)

If sh1.Range("M" & i + 1) = "y" Then

strSQL = "insert into corn_expenses(编号,日期,项目名称,摘要,预支,支出,备注) values( '" & arr(i, 1) & "' , '" & Format(arr(i, 2), "yyyy-mm-dd") & "','" & arr(i, 3) & "' ,'" & arr(i, 4) & "' ,'" & arr(i, 5) & "' ,'" & arr(i, 6) & "','" & arr(i, 7) & "' );"

cn.Execute strSQL

sh1.Range("M" & i + 1) = "Inserted"

Else

MsgBox ("Sorry,请检查数据状态（必须为 y ）")

End If

Next

cn.Close

End Sub

二、删除数据

在 P2 单元格中输入要删除数据的编号，如下图

点击删除按钮，如下图

打开 SQLite3 数据库，可以看到，2号数据已经不存在了。

代码：

Sub Expenses_Delete_Click()

Dim sh1 As Worksheet

Dim strSQL As String

Dim i As Integer

Dim sht_id As String

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set sh1 = Sheets(1)

cn.Open "DRIVER={SQLite3 ODBC Driver};Database=E:\\mydb\\expenses.db"

sht_id = sh1.Range("P2").Value

strSQL = "Delete FROM corn_expenses where 编号 = '" & sht_id & "' ;"

'rs.Open strSql, cnn, adOpenStatic, adLockReadOnly

cn.Execute (strSQL)

MsgBox ("OK,deleted")

cn.Close

End Sub

三、修改数据

假如将1号数据按如下修改，如下图

修改完成后，点击修改按钮

提示数据已经修改，打开数据库查看，如下图

代码

Sub Expenses_Update_Click()

Dim sh1 As Worksheet

Dim strSQL As String, strDate$, item$, description$, advance As Double, expenses As Double, remark$

Dim i As Integer

Dim sht_id As String

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set sh1 = Sheets(1)

cn.Open "DRIVER={SQLite3 ODBC Driver};Database=E:\\mydb\\expenses.db"

sht_id = sh1.Range("P2").Value

strDate = sh1.Range("B2")

item = sh1.Range("C2")

description = sh1.Range("D2")

advance = sh1.Range("E2")

expenses = sh1.Range("F2")

remark = sh1.Range("G2")

strSQL = "SELECT * FROM corn_expenses where 编号= '" & sht_id & "';"

'rs.Open strSql, cnn, adOpenStatic, adLockReadOnly

rs.Open strSQL, cn, 1, 1

If Not rs.EOF Then

strSQL = "Update corn_expenses set 日期='" & strDate & "' ,项目名称 ='" & item & "' ,摘要='" & description & "' ,预支='" & advance & "' , " _

& "支出='" & expenses & "',备注='" & remark & "' where 编号 = '" & sht_id & "' ;"

cn.Execute (strSQL)

MsgBox ("OK,updated")

sh1.Range("M2") = "Updated"

Else

MsgBox ("没有要更新的条目")

End If

cn.Close

End Sub

四、查询数据

点击查询按钮，如下图，可以看到查询结果

我们新增一条数据

再次点击查询，我们可以看到全部数据

代码

Sub Expenses_Query()

Dim sh1 As Worksheet

Dim strSQL As String

Dim i As Integer, n%

Dim rng As Range

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set sh1 = Sheets(1)

With sh1

.Range("A1:M100").Clear

.Range("M1") = "Results"

End With

cn.Open "DRIVER={SQLite3 ODBC Driver};Database=E:\\mydb\\expenses.db"

strSQL = "SELECT 编号,日期,项目名称,摘要,预支,支出,备注 FROM corn_expenses"

'rs.Open strSql, cnn, adOpenStatic, adLockReadOnly

rs.Open strSQL, cn, 1, 1

For i = 1 To rs.Fields.Count

sh1.Cells(1, i) = rs.Fields(i - 1).Name

Next

'cnn.Execute "create table a (a, b, c);" '直接Sql操作

If Not rs.EOF Then

sh1.Range("A2").CopyFromRecordset rs

For i = 1 To rs.RecordCount

sh1.Range("M" & i + 1) = "OK"

Next

Else

sh1.Range("M" & 2) = "NULL"

End If

n = sh1.Range("A65536").End(xlUp).Row

sh1.Range("A1:M1").BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic

Set rng = sh1.Range("A1:M" & n)

rng.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic

rng.HorizontalAlignment = xlLeft

rng.VerticalAlignment = xlCenter

rs.Close

cn.Close

End Sub

也可以在 P2 单元格输入编号进行查询

在 P3 单元格输入项目名称，点击查询

编号查询代码

Sub Expenses_Query_ID()

Dim sh1 As Worksheet

Dim strSQL As String, sht_id$

Dim i As Integer, n%

Dim rng As Range

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set sh1 = Sheets(1)

With sh1

.Range("A1:M100").Clear

.Range("M1") = "Results"

End With

cn.Open "DRIVER={SQLite3 ODBC Driver};Database=E:\\mydb\\expenses.db"

sht_id = sh1.Range("P2").Value

strSQL = "SELECT * FROM corn_expenses where 编号= '" & sht_id & "';"

'rs.Open strSql, cnn, adOpenStatic, adLockReadOnly

rs.Open strSQL, cn, 1, 1

For i = 1 To rs.Fields.Count

sh1.Cells(1, i) = rs.Fields(i - 1).Name

Next

'cnn.Execute "create table a (a, b, c);" '直接Sql操作

If Not rs.EOF Then

sh1.Range("A2").CopyFromRecordset rs

For i = 1 To rs.RecordCount

sh1.Range("M" & i + 1) = "OK"

Next

Else

MsgBox ("没有找到")

End If

n = sh1.Range("A65536").End(xlUp).Row

sh1.Range("A1:M1").BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic

Set rng = sh1.Range("A1:M" & n)

rng.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic

rng.HorizontalAlignment = xlLeft

rng.VerticalAlignment = xlCenter

rs.Close

cn.Close

End Sub

项目名称查询代码

Sub Expenses_Query_Product()

Dim sh1 As Worksheet

Dim strSQL As String, product$

Dim i As Integer, n%

Dim rng As Range

Dim cn As New ADODB.Connection

Dim rs As New ADODB.Recordset

Set sh1 = Sheets(1)

With sh1

.Range("A1:M100").Clear

.Range("M1") = "Results"

End With

cn.Open "DRIVER={SQLite3 ODBC Driver};Database=E:\\mydb\\expenses.db"

product = sh1.Range("P3").Value

strSQL = "SELECT * FROM corn_expenses where 项目名称 like '%" & product & "%';"

'rs.Open strSql, cnn, adOpenStatic, adLockReadOnly

rs.Open strSQL, cn, 1, 1

For i = 1 To rs.Fields.Count

sh1.Cells(1, i) = rs.Fields(i - 1).Name

Next

'cnn.Execute "create table a (a, b, c);" '直接Sql操作

If Not rs.EOF Then

sh1.Range("A2").CopyFromRecordset rs

For i = 1 To rs.RecordCount

sh1.Range("M" & i + 1) = "OK"

Next

Else

MsgBox ("没有找到")

End If

n = sh1.Range("A65536").End(xlUp).Row

sh1.Range("A1:M1").BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic

Set rng = sh1.Range("A1:M" & n)

rng.BorderAround LineStyle:=xlContinuous, Weight:=xlThin, ColorIndex:=xlAutomatic

rng.HorizontalAlignment = xlLeft

rng.VerticalAlignment = xlCenter

rs.Close

cn.Close

End Sub

好了，至此，已经完成基本的增删改查的功能。