My data doesn't save to table via VBA code (1 Viewer)

5hadow

Member
Local time
Today, 19:08
Joined
Apr 26, 2021
Messages
89
Hello all,

I am trying to add a user from a sub-form which pulls details from Outlook. Once I press a button, it should save the record and add it to my table. For some reason it does not do that.
Here is the code in question:
Code:
    ' Add the entry
    CurrentDb.Execute "INSERT INTO tblMember(fldLastName,fldFirstName,fldEmail,fldTradeID,fldSectionID)VALUES('" & txtLast.Value & "','" & txtFirst.Value & "','" & txtEmail.Value & "'," & lstTrade.Value & "," & lstSection.Value & ");"
    
    ' Exit the form
    DoCmd.Close acForm, Me.Name, acSaveYes
    
    ' Update
    Forms!frmMembers.Requery

Here is the full code for this sub-form:

Code:
Option Compare Database

Private Sub Form_Load()

    lstTrade.Value = lstTrade.ItemData(0)
    lstSection.Value = lstSection.ItemData(0)

    If Len(Me.OpenArgs) > 0 Then
        
        Dim nameArray() As String
        nameArray() = Split(Me.OpenArgs, " ")
        
        If UBound(nameArray) = 0 Then
            txtLast.Value = nameArray(0)
            
        ElseIf UBound(nameArray) = 1 Then
            txtLast.Value = nameArray(0)
            txtFirst.Value = nameArray(1)
            
        End If
        
    End If

End Sub

Private Sub lstSection_NotInList(NewData As String, Response As Integer)

    Response = acDataErrContinue
    AddNewSection NewData
    
End Sub

Private Sub lstTrade_NotInList(NewData As String, Response As Integer)

    Response = acDataErrContinue
    AddNewTrade NewData
    
End Sub

Private Sub cmdGetEmail_Click()

    On Error GoTo ErrorHandler
    
    Dim objOutlook As Outlook.Application
    Set objOutlook = CreateObject("Outlook.Application")
        
    Dim objNamespace As Outlook.NameSpace
    Set objNamespace = objOutlook.GetNamespace("MAPI")
        
    With objNamespace.Session.GetSelectNamesDialog
      
        .ShowOnlyInitialAddressList = True
        .SetDefaultDisplayMode olDefaultSingleName
        .AllowMultipleSelection = False
        .Caption = "Select Member"
        .NumberOfRecipientSelectors = olShowNone
      
        If .Display Then
        
            'Recipients Resolved
            With .Recipients(1)
                
                txtLast.Value = .AddressEntry.GetExchangeUser.LastName
                txtFirst.Value = .AddressEntry.GetExchangeUser.FirstName
                txtEmail.Value = .AddressEntry.GetExchangeUser.PrimarySmtpAddress
                
            End With
            
        End If
      
    End With

    Set objNamespace = Nothing
    Set objDialog = Nothing
    
    Exit Sub
    
ErrorHandler:
    MsgBox Err.Description, vbOKOnly, "Error #: " & Err.Number
    Exit Sub
    
End Sub

Private Sub cmdOk_Click()

    Dim Fail As Boolean: Fail = False
    
    ' Check to ensure the pertinate data has been intput
    If Not Len(txtLast.Value) > 0 Then
        txtLast.BackColor = RGB(255, 0, 0)
        Fail = True
    Else
        txtLast.BackThemeColorIndex = 1
    End If
    
    If Not Len(txtFirst.Value) > 0 Then
        txtFirst.BackColor = RGB(255, 0, 0)
        Fail = True
    Else
        txtFirst.BackThemeColorIndex = 1
    End If
    
    If Not Len(lstTrade.Value) > 0 Then
        lstTrade.BackColor = RGB(255, 0, 0)
        Fail = True
    Else
        lstTrade.BackThemeColorIndex = 1
    End If
    
    If Not Len(lstSection.Value) > 0 Then
        lstSection.BackColor = RGB(255, 0, 0)
        Fail = True
    Else
        lstSection.BackThemeColorIndex = 1
    End If
    
    If Not Len(txtEmail.Value) > 0 Then
        txtEmail.BackColor = RGB(255, 0, 0)
        Fail = True
    Else
        txtEmail.BackThemeColorIndex = 1
    End If
    
    If Fail Then
        
        With CreateObject("WScript.Shell")
            Select Case .PopUp("Please fill in all the data in the red boxes before hitting Ok!", 2, "Information", 48)
                Case 1, -1
                    Exit Sub
            End Select
        End With
        
    End If
    
    On Error GoTo ErrorHandler
    
    ' Add the entry
    CurrentDb.Execute "INSERT INTO tblMember(fldLastName,fldFirstName,fldEmail,fldTradeID,fldSectionID)VALUES('" & txtLast.Value & "','" & txtFirst.Value & "','" & txtEmail.Value & "'," & lstTrade.Value & "," & lstSection.Value & ");"
    
    ' Exit the form
    DoCmd.Close acForm, Me.Name, acSaveYes
    
    ' Update
    Forms!frmMembers.Requery
        
    Exit Sub
    
ErrorHandler:
    If Err.Number <> 2046 Then
        MsgBox Err.Description, vbOKOnly, "Error #: " & Err.Number
        Exit Sub
    End If
    
End Sub

Private Sub cmdCancel_Click()

    On Error GoTo ErrorHandler
    
    DoCmd.Close acForm, Me.Name, acSaveNo
    Exit Sub
    
ErrorHandler:
    If Err.Number <> 2046 Then
        MsgBox Err.Description, vbOKOnly, "Error #: " & Err.Number
        Exit Sub
    End If

End Sub
 

theDBguy

I’m here to help
Staff member
Local time
Today, 16:08
Joined
Oct 29, 2018
Messages
21,358
Hi. Try adding dbFailOnError in your Execute line to see if you get any notifications why the record was not getting saved.
 

plog

Banishment Pending
Local time
Today, 18:08
Joined
May 11, 2011
Messages
11,612
Get the SQL statement you are creating, paste it into a query object and see if it runs or gives an error there.

Offhand, I see no spaces around the keyword "VALUES"
 

5hadow

Member
Local time
Today, 19:08
Joined
Apr 26, 2021
Messages
89
Hi. Try adding dbFailOnError in your Execute line to see if you get any notifications why the record was not getting saved.
Hey thanks for your help.

I get the following message: Error 3022
The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. Change the data in the field or fields that contain duplicate data, remove the index, or redefine the index to permit duplicate entries and try again.
Edit: I cannot find any duplicate data anywhere in any table. Not sure where it's pointing to.
Sorry, It's probably obvious that I'm really new to VBA and Access
 
Last edited:

theDBguy

I’m here to help
Staff member
Local time
Today, 16:08
Joined
Oct 29, 2018
Messages
21,358
Hey thanks for your help.

I get the following message: Error 3022

Edit: I cannot find any duplicate data anywhere in any table. Not sure where it's pointing to.
Sorry, It's probably obvious that I'm really new to VBA and Access
Try creating a SELECT query with the same data you're attempting to INSERT and compare the result against your table's data.
 

Users who are viewing this thread

Top Bottom