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

谢谢你的所有评论，我仍然有问题，但我已经提出了这个解决方案，它工作得很好。

我创建了一个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

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

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

达伦