VBA ADODB Transactions

Question

Have an application developed in Access 2010 connected to MySQL Server via ODBC.

I have 2 tables

ContactDetails with columns:

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

and ReportingType with columns:

ID, ReportType, ContactID, TimeStamp

I'm using a ADO transaction but when inserting into ContactDetails, I need to retrieve the ID so I can insert a corresponding record into ReportingType and set ReportingType.ContactID to be ContactDetails.ID.

In VB.Net I know I can use "Select LAST_INSERT_ID()" at the end of the SQL statement and ExecuteScalar will return the auto incremented ID.

Below is my 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

Please can you help me with this?

Answer 1

Thank you for all comments, I continued to have problems however I have come up with this solution which works quite well.

I created a MySQL Stored Procedure:

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

I then Called the Stored Procedure:

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

Need to do a bit of tidying but I got the result I needed.

Again thank you for taking the time answer my original question.

Darren