MS Access VBA SQL查询运行，但不插入

Question

我正在尝试制作一个MS Access应用程序，对VBA来说是相当新的东西，但对MySQL来说却是。 我遇到的问题是我试图向表中插入值，代码运行时未给出错误，但表未更新。 有人可以帮忙吗？

我主要遇到以下问题：

 db.Execute ("INSERT INTO Transaction ([TranDate], TranItem365, TranAmount, TranOperation) VALUES ( #" & Now() & "# , " & txtTranItem365.Value & ", " & txtTranAmount.Value & ", '" & txtTranOperation.Value & "')")

---

这是上下文的完整代码。

Private Sub btnApplyTransaction_Click()

Dim db As Database
Dim sql As String
Dim oper As String

Set db = CurrentDb()

If txtTranItem365.ListIndex = -1 Then
    MsgBox "Please select an item.", vbCritical
ElseIf txtTranAmount.Value = "" Then
    MsgBox "Please enter an amount.", vbCritical
ElseIf txtTranOperation.Value = "Issue" And txtIssuedToDept.ListIndex = -1 Then
    MsgBox "Please select a department to issue to.", vbCritical
Else:


    sql = DLookup("[ItmStock]", "Items", "[Itm365]=" & txtTranItem365.Value)

    oper = "+"

    If txtTranOperation.Value = "Issue" Then
        oper = "-"
    End If

    db.Execute ("Update Items set ItmStock = (" & sql & oper & txtTranAmount & ") where Itm365=" & txtTranItem365.Value)
    db.Execute ("INSERT INTO Transaction ([TranDate], TranItem365, TranAmount, TranOperation) VALUES ( #" & Now() & "# , " & txtTranItem365.Value & ", " & txtTranAmount.Value & ", '" & txtTranOperation.Value & "')")
    If txtTranOperation.Value = "Issue" Then
        sql = "32"
        MsgBox "INSERT INTO Issueance values (" & sql & ", " & txtIssuedToDept.Value & ", " & txtIssuedTo.Value & ")"
        db.Execute ("INSERT INTO Issueance values (" & sql & ", " & txtIssuedToDept.Value & ", '" & txtIssuedTo.Value & "')")
    End If

    txtTranAmount.Value = ""
    txtTranItem365 = ""
    txtTranOperation = "Add"
    txtIssuedTo = ""
    txtIssuedToDept = ""
    DoCmd.RefreshRecord
    db.Close

End If

更多上下文：TranDate是Date + Time，本质上是Now（）函数。 TranItem365是一个数字。 TranAmount是一个数字。 TranOperation是[“添加”，“问题”]。

Answer 1

从表定义解决完整性违规问题后，请考虑使用MS Access QueryDefs进行参数化查询，以使工作流程更具可读性和可维护性。

它有助于将SQL与VBA分开，以避免混乱，难以阅读，容易出错的连接和引号括起来。 此外，如果使用If块并且在查询中可以使用Now()则无需使用纯SQL作为DLookUp 。

SQL更新查询（另存为查询对象，根据需要调整数据类型）

PARAMETERS txtTranAmountParam Double, txtTranOperationParam Text, txtTranItem365Param Long;
UPDATE [Items] 
SET ItmStock = IIF([txtTranOperationParam] = 'Issue',
                   ItmStock - [txtTranAmountParam],
                   ItmStock + [txtTranAmountParam])
WHERE Itm365 = txtTranItem365Param;

SQL追加查询（另存为查询对象，根据需要调整数据类型）

PARAMETERS txtTranAmountParam Double, txtTranOperationParam Text, txtTranItem365Param Long;
INSERT INTO Transaction ([TranDate], TranItem365, TranAmount, TranOperation) 
VALUES (Now(), [txtTranItem365Param], [txtTranAmountParam], [txtTranOperationParam]);

SQL追加查询（另存为查询对象，根据需要调整数据类型）

PARAMETERS SQLParam Long, txtIssuedToDeptParam Long, txtIssuedToParam Long;
INSERT INTO Issueance VALUES ([SQLParam], [txtIssuedToDeptParam], [txtIssuedToParam])

VBA （引用上面的查询对象）

Private Sub btnApplyTransaction_Click()

   Dim db As Database
   Dim upd_qdef As QueryDef, apn_qdef As QueryDef, iss_qdef As QueryDef
   Dim sql As String, oper As String

   Set db = CurrentDb()

   If txtTranItem365.ListIndex = -1 Then
       MsgBox "Please select an item.", vbCritical
       Exit Sub 
   End If
   If txtTranAmount.Value = "" Then
       MsgBox "Please enter an amount.", vbCritical
       Exit Sub 
   End If
   If txtTranOperation.Value = "Issue" And txtIssuedToDept.ListIndex = -1 Then
       MsgBox "Please select a department to issue to.", vbCritical
       Exit Sub 
   End If

   ' ASSIGN QUERYDEFS, BIND PARAMS, AND EXECUTE ACTION
   ' UPDATE
   Set upd_qdef = db.QueryDefs("mySavedUpdateQuery")
   upd_qdef!txtTranAmountParam = txtTranAmount
   upd_qdef!txtTranOperationParam = txtTranOperation.Value
   upd_qdef!txtTranItem365Param = txtTranItem365.Value

   upd_qdef.Execute dbFailOnError

   ' APPEND
   Set apn_qdef = db.QueryDefs("mySavedAppendQuery")
   apn_qdef!txtTranAmountParam = txtTranAmount
   apn_qdef!txtTranOperationParam = txtTranOperation.Value
   apn_qdef!txtTranItem365Param = txtTranItem365.Value

   apn_qdef.Execute dbFailOnError

   If txtTranOperation.Value = "Issue" Then
        Set iss_qdef = db.QueryDefs("mySavedIssueanceAppendQuery")

        iss_qdef!SQLParam = 32
        iss_qdef!txtIssuedToDeptParam = txtIssuedToDept.Value
        iss_qdef!txtIssuedToDeptParam = txtIssuedTo.Value

        iss_qdef.Execute dbFailOnError
   End If

   txtTranAmount.Value = "": txtTranItem365 = "": txtTranOperation = "Add"
   txtIssuedTo = "": txtIssuedToDept = ""

   DoCmd.RefreshRecord

   Set upd_qdef = Nothing: apn_qdef = Nothing: iss_qdef = Nothing
   Set db = Nothing    
End If