VBA ADODB交易

Question

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

我有2个表

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 

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

再次感谢您花时间回答我原来的问题。

达伦