VBA ADODB Transactions

Question

Avoir une application développée dans Access 2010 connectée au serveur MySQL via ODBC.

J'ai 2 tables

ContactDetails avec des colonnes:

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

et ReportingType avec des colonnes:

ID, ReportType, ContactID, TimeStamp 

J'utilise une transaction ADO, mais lors de l'insertion dans ContactDetails, j'ai besoin pour récupérer l'ID afin que je puisse insérer un enregistrement correspondant dans ReportingType et définir ReportingType.ContactID pour être ContactDetails.ID.

Dans VB.Net, je sais que je peux utiliser "Select LAST_INSERT_ID()" à la fin de l'instruction SQL et ExecuteScalar renverra l'incrément automatique ID.

Ci-dessous est mon code

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 

S'il vous plaît pouvez-vous me aider?

Answer 1

Merci pour tous les commentaires, j'ai continué à avoir des problèmes mais j'ai trouvé cette solution qui marche plutôt bien.

J'ai créé un MySQL procédure stockée:

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 

J'ai alors appelé la procédure stockée:

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 

besoin de faire un peu de rangement mais je m'y suis le résultat que je avais besoin.

Encore une fois merci d'avoir pris le temps de répondre à ma question originale.

Darren