VBA ADODB 事务

Question

让在 Access 2010 中开发的应用程序通过 ODBC 连接到 MySQL 服务器。

我有两张桌子

ContactDetails 带列：

ID, FirstName, LastName, TelNo, MobileNo, EmailAddress, PrimaryContact, TimeStamp

和ReportingType 与列：

ID, ReportType, ContactID, TimeStamp

我正在使用 ADO 事务，但在插入 ContactDetails 时，我需要检索 ID，以便将相应的记录插入 ReportingType 并将 ReportingType.ContactID 设置为 ContactDetails.ID。

在 VB.Net 中，我知道我可以在 SQL 语句末尾使用“Select LAST_INSERT_ID()”，ExecuteScalar 将返回自动递增的ID。

下面是我的代码

Dim conn As ADODB.Connection

On Error GoTo ErrorHandler
Set conn = CurrentProject.Connection

With conn

    .BeginTrans

     'insert a new customer record
    .Execute "INSERT INTO ContactDetails (" & _
             "FirstName, " & _
             "LastName , " & _
             "TelNo , " & _
             "MobileNo ," & _
             "EmailAddress ," & _
             "IsPrimaryContact) " & _
             "Values ( " & _
             "'" & Me.FirstName & "'," & _
             "'" & Me.LastName & "'," & _
             "'" & Me.TeleNum & "'," & _
             "'" & Me.MobileNum & "'," & _
             "'" & Me.EmailAddress & "'," & _
             False & ");", , adCmdText + adExecuteNoRecords

            'Added from a possible solution
            Dim rs As New ADODB.Recordset
            Set rs = conn.Execute("SELECT @@Identity", , adCmdText)
            Debug.Print rs.Fields(0).Value  ' This returned 0

        'Inset a new record into the ReportingType Table
        For i = 1 To ListView1.ListItems.Count
            If ListView1.ListItems(i).Checked Then
                 .Execute "INSERT INTO ReportingType " & _
                          "(ReportType,  ContactID) " & _
                          "VALUES " & _
                          "('" & colReportType(ListView1.ListItems(i)) & "' , " & ContactID & ")"
            End If

        Next i

    .CommitTrans
End With
ExitHere:
    Set conn = Nothing
    Exit Sub
ErrorHandler:
    If Err.Number = -2147467259 Then
        MsgBox Err.Description
        Resume ExitHere
    Else
        MsgBox Err.Description
        With conn
            .RollbackTrans
            '.Close
        End With
        Resume ExitHere
    End If
End Sub

你能帮我解决这个问题吗？

Answer 1

感谢所有 cmets，我仍然遇到问题，但是我想出了这个效果很好的解决方案。

我创建了一个 MySQL 存储过程：

CREATE  PROCEDURE `SPAddPartnerContact`(IN `PartnerID` INT(8), IN `FirstName` VARCHAR(255), IN `LastName` VARCHAR(255), IN `TelNo` VARCHAR(10), IN `MobileNo` VARCHAR(10), IN `EmailAddress` TEXT, IN `IsPrimaryContact` TINYINT(2), IN `_list` TEXT)
BEGIN
DECLARE _next TEXT DEFAULT NULL;
DECLARE _nextlen INT DEFAULT NULL;
DECLARE _value TEXT DEFAULT NULL;
DECLARE _ContactID INT DEFAULT 0;

DECLARE exit handler for sqlexception
  BEGIN
    -- ERROR
  ROLLBACK;
END;

DECLARE exit handler for sqlwarning
 BEGIN
    -- WARNING
 ROLLBACK;
END;

START TRANSACTION;

INSERT INTO 
ContactDetails 
(BP_ID, FirstName, 
 LastName, TelNo , 
 MobileNo, 
 EmailAddress,
 IsPrimaryContact)
Values 
(PartnerID, 
 FirstName, 
 LastName, 
 TelNo, 
 MobileNo,
 EmailAddress, 
 IsPrimaryContact);

SET _ContactID = LAST_INSERT_ID();


iterator:
LOOP
  IF LENGTH(TRIM(_list)) = 0 OR _list IS NULL THEN
    LEAVE iterator;
  END IF;

  SET _next = SUBSTRING_INDEX(_list,',',1);
  SET _nextlen = LENGTH(_next);
  SET _value = TRIM(_next);

  INSERT INTO ReportingType (ReportType, BP_ID, ContactID) VALUES (_next, PartnerID, _ContactID);
  SET _list = INSERT(_list,1,_nextlen + 1,'');
END LOOP;

COMMIT;



END

然后我调用了存储过程：

Private Sub AddPartnerContact()
Dim ContactID As Long

Dim cmdSQL As ADODB.Command
Dim rsAddContact As New ADODB.Recordset

Dim bRecordAdded As Boolean
Dim sList As String
Dim delimiter As String

delimiter = ", "

On Error GoTo ErrorHandler


    Set cmdSQL = New ADODB.Command

    With cmdSQL
        .ActiveConnection = Replace(DBEngine.Workspaces(0).Databases(0).TableDefs("ContactDetails").connect, "ODBC;", "")
        .CommandType = adCmdStoredProc
        .CommandText = "SPAddPartnerContact"
        .Parameters.Append .CreateParameter("PartnerID", adInteger, adParamInput, 8, PartnerID)
        .Parameters.Append .CreateParameter("FirstName", adVarChar, adParamInput, 255, Me.FirstName)
        .Parameters.Append .CreateParameter("LastName", adVarChar, adParamInput, 255, Me.LastName)
        .Parameters.Append .CreateParameter("TelNo", adVarChar, adParamInput, 50, Me.TeleNum)
        .Parameters.Append .CreateParameter("MobileNo", adVarChar, adParamInput, 50, Me.MobileNum)
        .Parameters.Append .CreateParameter("EmailAddress", adVarChar, adParamInput, 255, Me.EmailAddress)
        .Parameters.Append .CreateParameter("IsPrimaryContact", adTinyInt, adParamInput, 50, Me.PrimaryContact)

            For i = 1 To ListView1.ListItems.Count
                If ListView1.ListItems(i).Checked Then
                    sList = sList & colReportType(ListView1.ListItems(i)) & delimiter
                End If
            Next i

             sList = Left(sList, Len(sList) - Len(delimiter))

            .Parameters.Append .CreateParameter("_list", adVarChar, adParamInput, 255, sList)


        .Execute
    End With


        '.Close

ExitHere:
    Set conn = Nothing

    If bRecordAdded Then
        MsgBox "Contact Added Successfully", vbOKOnly, "Contact Maintenance"
        Call cmdClose_Click
    End If


    Exit Sub
ErrorHandler:
    bRecordAdded = False
    If Err.Number = -2147467259 Then
        MsgBox Err.Description
        Resume ExitHere
    Else
        MsgBox Err.Description

        Resume ExitHere
    End If
End Sub

需要做一些整理，但我得到了我需要的结果。

再次感谢您抽出宝贵时间回答我最初的问题。

达伦