VBA-SQL UPDATE/INSERT/SELECT to/from Excel 工作表
VBA-SQL UPDATE/INSERT/SELECT to/from Excel worksheet
简而言之： 我正在为我的客户制作一个调度程序，由于限制，它需要在一个 excel 文件中（尽可能小尽可能）。因此，一个工作表用作 UI，其他任何工作表将用作表格或设置。
我正在尝试使用 SQL（我是新手）在单个工作表（名为 "TblEmpDays"）上处理计划数据。所以我需要 add/update 并检索记录 to/from 这个工作表。我能够得到一个 SELECT 查询来处理一些任意数据（并粘贴到一个范围）。但是，我无法让 INSERT 或 UPDATE 工作。我看到它的结构为 INSERT INTO [<table name>$] (<field names>) VALUES (<data>);。但是，这给了我 运行 时间错误“'-2147217900 (80040e14)' INSERT INTO 语句中的语法错误。”
我正在使用 VBA 编写所有这些内容，并且我制作了一个 SQL 帮助程序 class 以使查询执行更容易。
为了澄清，我的问题是：我需要如何构建 INSERT 和 UPDATE 查询？我错过了什么？我正在尝试 post 尽可能多的相关信息，所以如果我遗漏了什么，请告诉我。
Class SQL:
Private pCn ' As Database
Private pResult 'As Recordset
Private pSqlStr As String
Public Property Get Result()
Result = pResult
End Property
Public Function Init()
Set pCn = CreateObject("ADODB.Connection")
With pCn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Macro;HDR=YES;ReadOnly=False"";"
.Open
End With
End Function
Public Function Cleanup()
If Not (pCn Is Nothing) Then
pCn.Close
Set pCn = Nothing
End If
If Not pResult Is Nothing Then
Set pResult = Nothing
End If
End Function
Public Function CopyResultToRange(rg As Range)
If Not rg Is Nothing And Not pResult Is Nothing Then
rg.CopyFromRecordset pResult
End If
End Function
Public Property Get query() As String
query = pSqlStr
End Property
Public Property Let query(value As String)
pSqlStr = value
End Property
Public Function Execute(Optional sqlQuery As String)
If sqlQuery = "" Then
sqlQuery = query
End If
If Not pCn Is Nothing Then
Set pResult = pCn.Execute(sqlQuery, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
Else
MsgBox "SQL connection not established"
End If
End Function
执行函数：
Dim s As SQL ' this is the SQL class '
Dim tbl As String
' rcDay=date string, rcIn & rcOut = time strings, rcVac=boolean string, rcSls=number string'
Dim rcName As String, rcDay As String, rcIn As String, rcOut As String, rcVac As String, rcSls As String
Dim qry As String
tbl = "[TblEmpDays$]"
qry = "INSERT INTO <tbl> (name, date, in, out, vac, sales)" & vbNewLine & _
"VALUES ('<name>', '<date>', '<in>', '<out>', '<vac>', <sales>);"
' Set rc* vars '
s.Init
s.query = Replace(Replace(Replace(Replace(Replace(Replace(Replace(qry, _
"<tbl>", tbl), _
"<sales>", rcSls), _
"<vac>", rcVac), _
"<out>", rcOut), _
"<in>", rcIn), _
"<date>", rcDay), _
"<name>", rcName)
MsgBox s.query
s.Execute
s.Cleanup
我找遍了都找不到解决办法。我确定我只是没有搜索正确的短语或简单的东西。
考虑使用关系数据库作为后端而不是项目的工作表。您可以继续使用 UI 电子表格作为前端。作为 Windows 产品，Jet/ACE SQL 引擎可以成为一个可行的解决方案，而且它允许多个用户同时访问（使用记录级锁定）。此外，Jet/ACE 为 Database Definition Language (DDL) and Database Maniupulation Language (DML) 程序配备了自己的 SQL 方言。 Excel 可以通过 ADO/DAO 对象连接到 Jet/ACE。 Jet/ACE 与其他 RDMS 相比的唯一区别是它是一个文件级数据库（不是服务器），你不能使用 SQL 创建数据库。您必须首先使用 VBA 或其他 COM 定义的语言创建数据库文件。
下面是 VBA 脚本（客户和订单表）的工作示例，包括使用 DAO 创建数据库、使用 ADO 创建表、执行操作查询以及将记录集复制到工作表。将这些宏集成到您的项目中。使用错误处理和 debug.Print 来帮助开发您的应用程序。如果您没有安装 MS Access，.accdb 文件将显示在目录中，但图标为空白。除非通过代码，否则将没有用户界面来管理文件。
Sub CreateDatabase()
On Error GoTo ErrHandle
Dim fso As Object
Dim olDb As Object, db As Object
Dim strpath As String
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"
strpath = "C:\Path\To\Database\File.accdb"
' CREATE DATABASE '
Set fso = CreateObject("Scripting.FileSystemObject")
Set olDb = CreateObject("DAO.DBEngine.120")
If Not fso.FileExists(strpath) Then
Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
End If
Set db = Nothing
Set olDb = Nothing
Set fso = Nothing
MsgBox "Successfully created database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub CreateTables()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim objAccess As Object
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' CONNECT TO DATABASE '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' CREATE TABLES (RUN ONLY ONCE) '
conn.Execute "CREATE TABLE Clients (" _
& " ClientID AUTOINCREMENT," _
& " ClientName TEXT(255)," _
& " Address TEXT(255)," _
& " Notes TEXT(255)," _
& " DateCreated DATETIME" _
& ");"
conn.Execute "CREATE TABLE Orders (" _
& " OrderID AUTOINCREMENT," _
& " ClientID INTEGER," _
& " Item TEXT(255)," _
& " Price DOUBLE," _
& " OrderDate DATETIME," _
& " Notes TEXT(255)" _
& ");"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully created Clients and Orders tables!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub RetrieveDataToWorksheet()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object, rs As Object
Dim fld As Variant
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open constr
rs.Open "SELECT * FROM Clients" _
& " INNER JOIN Orders ON Clients.ClientID = Orders.ClientID;", conn
' COPY FROM RECORDSET TO WORKSHEET '
Worksheets(1).Activate
Worksheets(1).Range("A4").Select
' COLUMN NAMES '
For Each fld In rs.Fields
ActiveCell = fld.Name
ActiveCell.Offset(0, 1).Select
Next
' ROW VALUES '
Worksheets(1).Range("A5").CopyFromRecordset rs
' CLOSE RECORDSET AND CONNECTION '
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub ActionQueries()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' APPEND QUERY '
conn.Execute "INSERT INTO Clients (ClientID, ClientName)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", '" & Worksheets(1).Range("B2") & "');"
conn.Execute "INSERT INTO Orders (ClientID, Item, Price)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", " _
& "'" & Worksheets(1).Range("C2") & "', " _
& Worksheets(1).Range("D2") & ");"
' UPDATE QUERY '
conn.Execute "UPDATE Clients " _
& " SET Address = '" & Worksheets(1).Range("E2") & "'" _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' DELETE QUERY '
conn.Execute "DELETE FROM Orders " _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully updated database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
我在这里发布解决方案，因为我无法将他的评论标记为答案。
感谢 @Jeeped 的评论，我现在觉得自己像个白痴。结果我的三个字段名称使用了保留字（"name"、"date" 和 "in"）。 似乎总是一个微妙的细节让我...
我在我的工作表 (table) 中重命名了这些字段并更改了适当的代码。我还必须将输入字符串转换为正确的数据类型。我仍在研究其余的细节，但这是新查询：
qry = "INSERT INTO <tbl> (empName, empDay, inTime, outTime, vac, sales)" & vbNewLine & _
"VALUES (CStr('<name>'), CDate('<date>'), CDate('<in>'), CDate('<out>'), " & _
"CBool('<vac>'), CDbl(<sales>));"
我需要 CDate()（而不是 #*#），这样我就可以传入一个字符串。
所以 CDate('<date>') 而不是 #<date>#
简而言之： 我正在为我的客户制作一个调度程序，由于限制，它需要在一个 excel 文件中（尽可能小尽可能）。因此，一个工作表用作 UI，其他任何工作表将用作表格或设置。
我正在尝试使用 SQL（我是新手）在单个工作表（名为 "TblEmpDays"）上处理计划数据。所以我需要 add/update 并检索记录 to/from 这个工作表。我能够得到一个 SELECT 查询来处理一些任意数据（并粘贴到一个范围）。但是，我无法让 INSERT 或 UPDATE 工作。我看到它的结构为 INSERT INTO [<table name>$] (<field names>) VALUES (<data>);。但是，这给了我 运行 时间错误“'-2147217900 (80040e14)' INSERT INTO 语句中的语法错误。”
我正在使用 VBA 编写所有这些内容，并且我制作了一个 SQL 帮助程序 class 以使查询执行更容易。
为了澄清，我的问题是：我需要如何构建 INSERT 和 UPDATE 查询？我错过了什么？我正在尝试 post 尽可能多的相关信息，所以如果我遗漏了什么，请告诉我。
Class SQL:
Private pCn ' As Database
Private pResult 'As Recordset
Private pSqlStr As String
Public Property Get Result()
Result = pResult
End Property
Public Function Init()
Set pCn = CreateObject("ADODB.Connection")
With pCn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Macro;HDR=YES;ReadOnly=False"";"
.Open
End With
End Function
Public Function Cleanup()
If Not (pCn Is Nothing) Then
pCn.Close
Set pCn = Nothing
End If
If Not pResult Is Nothing Then
Set pResult = Nothing
End If
End Function
Public Function CopyResultToRange(rg As Range)
If Not rg Is Nothing And Not pResult Is Nothing Then
rg.CopyFromRecordset pResult
End If
End Function
Public Property Get query() As String
query = pSqlStr
End Property
Public Property Let query(value As String)
pSqlStr = value
End Property
Public Function Execute(Optional sqlQuery As String)
If sqlQuery = "" Then
sqlQuery = query
End If
If Not pCn Is Nothing Then
Set pResult = pCn.Execute(sqlQuery, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
Else
MsgBox "SQL connection not established"
End If
End Function
执行函数：
Dim s As SQL ' this is the SQL class '
Dim tbl As String
' rcDay=date string, rcIn & rcOut = time strings, rcVac=boolean string, rcSls=number string'
Dim rcName As String, rcDay As String, rcIn As String, rcOut As String, rcVac As String, rcSls As String
Dim qry As String
tbl = "[TblEmpDays$]"
qry = "INSERT INTO <tbl> (name, date, in, out, vac, sales)" & vbNewLine & _
"VALUES ('<name>', '<date>', '<in>', '<out>', '<vac>', <sales>);"
' Set rc* vars '
s.Init
s.query = Replace(Replace(Replace(Replace(Replace(Replace(Replace(qry, _
"<tbl>", tbl), _
"<sales>", rcSls), _
"<vac>", rcVac), _
"<out>", rcOut), _
"<in>", rcIn), _
"<date>", rcDay), _
"<name>", rcName)
MsgBox s.query
s.Execute
s.Cleanup
我找遍了都找不到解决办法。我确定我只是没有搜索正确的短语或简单的东西。
考虑使用关系数据库作为后端而不是项目的工作表。您可以继续使用 UI 电子表格作为前端。作为 Windows 产品，Jet/ACE SQL 引擎可以成为一个可行的解决方案，而且它允许多个用户同时访问（使用记录级锁定）。此外，Jet/ACE 为 Database Definition Language (DDL) and Database Maniupulation Language (DML) 程序配备了自己的 SQL 方言。 Excel 可以通过 ADO/DAO 对象连接到 Jet/ACE。 Jet/ACE 与其他 RDMS 相比的唯一区别是它是一个文件级数据库（不是服务器），你不能使用 SQL 创建数据库。您必须首先使用 VBA 或其他 COM 定义的语言创建数据库文件。
下面是 VBA 脚本（客户和订单表）的工作示例，包括使用 DAO 创建数据库、使用 ADO 创建表、执行操作查询以及将记录集复制到工作表。将这些宏集成到您的项目中。使用错误处理和 debug.Print 来帮助开发您的应用程序。如果您没有安装 MS Access，.accdb 文件将显示在目录中，但图标为空白。除非通过代码，否则将没有用户界面来管理文件。
Sub CreateDatabase()
On Error GoTo ErrHandle
Dim fso As Object
Dim olDb As Object, db As Object
Dim strpath As String
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"
strpath = "C:\Path\To\Database\File.accdb"
' CREATE DATABASE '
Set fso = CreateObject("Scripting.FileSystemObject")
Set olDb = CreateObject("DAO.DBEngine.120")
If Not fso.FileExists(strpath) Then
Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
End If
Set db = Nothing
Set olDb = Nothing
Set fso = Nothing
MsgBox "Successfully created database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub CreateTables()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim objAccess As Object
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' CONNECT TO DATABASE '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' CREATE TABLES (RUN ONLY ONCE) '
conn.Execute "CREATE TABLE Clients (" _
& " ClientID AUTOINCREMENT," _
& " ClientName TEXT(255)," _
& " Address TEXT(255)," _
& " Notes TEXT(255)," _
& " DateCreated DATETIME" _
& ");"
conn.Execute "CREATE TABLE Orders (" _
& " OrderID AUTOINCREMENT," _
& " ClientID INTEGER," _
& " Item TEXT(255)," _
& " Price DOUBLE," _
& " OrderDate DATETIME," _
& " Notes TEXT(255)" _
& ");"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully created Clients and Orders tables!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub RetrieveDataToWorksheet()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object, rs As Object
Dim fld As Variant
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open constr
rs.Open "SELECT * FROM Clients" _
& " INNER JOIN Orders ON Clients.ClientID = Orders.ClientID;", conn
' COPY FROM RECORDSET TO WORKSHEET '
Worksheets(1).Activate
Worksheets(1).Range("A4").Select
' COLUMN NAMES '
For Each fld In rs.Fields
ActiveCell = fld.Name
ActiveCell.Offset(0, 1).Select
Next
' ROW VALUES '
Worksheets(1).Range("A5").CopyFromRecordset rs
' CLOSE RECORDSET AND CONNECTION '
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub ActionQueries()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' APPEND QUERY '
conn.Execute "INSERT INTO Clients (ClientID, ClientName)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", '" & Worksheets(1).Range("B2") & "');"
conn.Execute "INSERT INTO Orders (ClientID, Item, Price)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", " _
& "'" & Worksheets(1).Range("C2") & "', " _
& Worksheets(1).Range("D2") & ");"
' UPDATE QUERY '
conn.Execute "UPDATE Clients " _
& " SET Address = '" & Worksheets(1).Range("E2") & "'" _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' DELETE QUERY '
conn.Execute "DELETE FROM Orders " _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully updated database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
我在这里发布解决方案，因为我无法将他的评论标记为答案。
感谢 @Jeeped 的评论，我现在觉得自己像个白痴。结果我的三个字段名称使用了保留字（"name"、"date" 和 "in"）。 似乎总是一个微妙的细节让我...
我在我的工作表 (table) 中重命名了这些字段并更改了适当的代码。我还必须将输入字符串转换为正确的数据类型。我仍在研究其余的细节，但这是新查询：
qry = "INSERT INTO <tbl> (empName, empDay, inTime, outTime, vac, sales)" & vbNewLine & _
"VALUES (CStr('<name>'), CDate('<date>'), CDate('<in>'), CDate('<out>'), " & _
"CBool('<vac>'), CDbl(<sales>));"
我需要 CDate()（而不是 #*#），这样我就可以传入一个字符串。
所以 CDate('<date>') 而不是 #<date>#