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 - это ["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