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 是日期+时间，本质是 Now() 函数。 TranItem365 是一个数字。 TranAmount 是一个数字。 TranOperation 是 ["Add", "Issue"]。

Answer 1

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

它有助于将 SQL 与 VBA 分开，以避免混乱、难以阅读、容易出错的连接和引用附件。此外，使用纯 SQL，因为 DLookUp 对于 If 块是不必要的，Now() 在查询中可用。

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

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

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

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

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

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