Writing listbox results to table

[PinkLady50]

My previous post was two parts. I got the comboboxes working now I need to get the listboxes to write to the table.



I have tried several things but nothing it writing. Also, the cmdAddVAC doesn't seem to be working, I have to click on the count at the bottom to advance to a new record to get it to write the data.

Private Sub cmdAddVAC_Click()
    
    Dim varItem As Variant    'Selected items
    Dim strDelim As String    'Delimiter for this field type.
    Dim i As Variant
    Dim ctl As Control
    Dim strCriteria As String
    Dim issuesValue As String, vacancyValue As String
    On Error GoTo ErrorHandler
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("tblPerfIssues")
 
 Debug.Print
    
    If Len(Me.cboAnalyst & vbNullString) = 0 Or Len(Me.txtReportDate & vbNullString) = 0 Or Len(Me.cboContractNumber & vbNullString) = 0 Then
        MsgBox "Please fill in Analyst/Specialist, Report Date and Contract Number"
        Exit Sub
    If Me.lstContractorIssues.ItemsSelected.Count = 0 Then
    MsgBox "Please select at least one item from Contractor Issues"
    Exit Sub
    End If
    For Each i In Me.lstContractorIssues.ItemsSelected
        issuesValue = issuesValue & ", " & Me.lstContractorIssues.ItemData(i)
    Next i
    
    For Each i In Me.lstVacancyReason.ItemsSelected
        vacancyValue = vacancyValue & ", " & Me.lstVacancyReason.ItemData(i)
    Next i
    Me.lstContractorIssues = Right(issuesValue, Len(issuesValue) - 1)
    Me.lstVacancyReason = Right(vacancyValue, Len(vacancyValue) - 1)
        'All the fields are writing correctly to the table but the the 2 listboxes (ContractorIssues lstContractorIssues) (VACReason lstVacancyReason)
         rs.AddNew
        .Fields("Analyst") = cboAnalyst.Value
        .Fields("ReportDate") = txtReportDate.Value
        .Fields("ContractNumber") = Me.cboContractNumber.Column(0)
        .Fields("Contractor") = txtContractor.Value
        .Fields("MATO") = txtMATO.Value
        .Fields("ContractorOnset") = txtContractorOnset.Value
        .Fields("ContractorResolved") = txtContractorResolved.Value
        .Fields("ContractorComments") = txtContractorComments.Value
        .Fields("ContractorIssues") = lstContractorIssues.Value   'Not writing to tbl
        .Fields("VACTO") = cboTOvac.Value
        .Fields("VACCLIN") = cboCLINvac.Column(2)
        .Fields("VACCOR") = txtCORVAC.Value
        .Fields("VACMTF") = txtMTFVAC.Value
        .Fields("VACLabor") = txtLaborvac.Value
        .Fields("VACSite") = txtSiteVAC.Value
        .Fields("VACClinic") = txtClinicalVAC.Value
        .Fields("VACIndcov") = txtIndCovVAC.Value
        .Fields("MissedHours") = txtIndHours.Value
        .Fields("MissedShifts") = txtCovHours.Value
        .Fields("TOStart") = txtTOStart.Value
        .Fields("TOEnd") = txtTOEnd.Value
        .Fields("VACFrom") = txtVacFrom.Value
        .Fields("VACTo") = txtVacTo.Value
        .Fields("VACReason") = lstVacancyReason.Value        'Not writing to tbl
        .Fields("VACComments") = txtVACComments.Value
        .Update
        
Debug.Print
        Set rst = Nothing
    
   
   
End Sub

[davegri]

Private Sub cmdAddVAC_Click()
    
    Dim varItem As Variant    'Selected items
    Dim strDelim As String    'Delimiter for this field type.
    Dim i As Variant
    Dim ctl As Control
    Dim strCriteria As String
    Dim issuesValue As String, vacancyValue As String
    On Error GoTo ErrorHandler
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("tblPerfIssues")
 
 Debug.Print
    
    If Len(Me.cboAnalyst & vbNullString) = 0 Or Len(Me.txtReportDate & vbNullString) = 0 Or Len(Me.cboContractNumber & vbNullString) = 0 Then
        MsgBox "Please fill in Analyst/Specialist, Report Date and Contract Number"
        Exit Sub
    If Me.lstContractorIssues.ItemsSelected.Count = 0 Then
    MsgBox "Please select at least one item from Contractor Issues"
    Exit Sub
    End If
    For Each i In Me.lstContractorIssues.ItemsSelected
        issuesValue = issuesValue & ", " & Me.lstContractorIssues.ItemData(i)
    Next i
    
    For Each i In Me.lstVacancyReason.ItemsSelected
        vacancyValue = vacancyValue & ", " & Me.lstVacancyReason.ItemData(i)
    Next i
    issuesValue = Right(issuesValue, Len(issuesValue) - 1)
    vacancyValue = Right(vacancyValue, Len(vacancyValue) - 1)
        'All the fields are writing correctly to the table but the the 2 listboxes (ContractorIssues lstContractorIssues) (VACReason lstVacancyReason)
         rs.AddNew
        .Fields("Analyst") = cboAnalyst.Value
        .Fields("ReportDate") = txtReportDate.Value
        .Fields("ContractNumber") = Me.cboContractNumber.Column(0)
        .Fields("Contractor") = txtContractor.Value
        .Fields("MATO") = txtMATO.Value
        .Fields("ContractorOnset") = txtContractorOnset.Value
        .Fields("ContractorResolved") = txtContractorResolved.Value
        .Fields("ContractorComments") = txtContractorComments.Value
        .Fields("ContractorIssues") = issuesValue   'Not writing to tbl
        .Fields("VACTO") = cboTOvac.Value
        .Fields("VACCLIN") = cboCLINvac.Column(2)
        .Fields("VACCOR") = txtCORVAC.Value
        .Fields("VACMTF") = txtMTFVAC.Value
        .Fields("VACLabor") = txtLaborvac.Value
        .Fields("VACSite") = txtSiteVAC.Value
        .Fields("VACClinic") = txtClinicalVAC.Value
        .Fields("VACIndcov") = txtIndCovVAC.Value
        .Fields("MissedHours") = txtIndHours.Value
        .Fields("MissedShifts") = txtCovHours.Value
        .Fields("TOStart") = txtTOStart.Value
        .Fields("TOEnd") = txtTOEnd.Value
        .Fields("VACFrom") = txtVacFrom.Value
        .Fields("VACTo") = txtVacTo.Value
        .Fields("VACReason") = vacancyValue        'Not writing to tbl
        .Fields("VACComments") = txtVACComments.Value
        .Update
        
Debug.Print
        Set rst = Nothing
End Sub

Try the red changes

[ssanfu]

I have tried several things but nothing it writing. Also, the cmdAddVAC doesn't seem to be working, I have to click on the count at the bottom to advance to a new record to get it to write the data.

I saw several things wrong......take a look at this

Option Compare Database  '<-- should be at the top of every code page
Option Explicit          '<-- should be at the top of every code page

Private Sub cmdAddVAC_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim i As Variant
    Dim issuesValue As String, vacancyValue As String

    '---variables not used---
    '   Dim varItem As Variant    'Selected items
    '   Dim strDelim As String    'Delimiter for this field type.
    '   Dim ctl As Control
    '   Dim strCriteria As String


    On Error GoTo ErrorHandler

    Set db = CurrentDb()
    Set rs = db.OpenRecordset("tblPerfIssues")


    If Len(Me.cboAnalyst & vbNullString) = 0 Or Len(Me.txtReportDate & vbNullString) = 0 Or Len(Me.cboContractNumber & vbNullString) = 0 Then
        MsgBox "Please fill in Analyst/Specialist, Report Date and Contract Number"
    Else
        If Me.lstContractorIssues.ItemsSelected.Count = 0 Then
            MsgBox "Please select at least one item from Contractor Issues"
        Else
            'loop through the multi select list box lstContractorIssues to get issues
            For Each i In Me.lstContractorIssues.ItemsSelected
                issuesValue = issuesValue & ", " & Me.lstContractorIssues.ItemData(i)
            Next i

            'loop through the multi select list box lstVacancyReason to get reasons
            For Each i In Me.lstVacancyReason.ItemsSelected
                vacancyValue = vacancyValue & ", " & Me.lstVacancyReason.ItemData(i)
            Next i

            '            Me.lstContractorIssues = Right(issuesValue, Len(issuesValue) - 1)
            '            Me.lstVacancyReason = Right(vacancyValue, Len(vacancyValue) - 1)
            issuesValue = Right(issuesValue, Len(issuesValue) - 2)
            vacancyValue = Right(vacancyValue, Len(vacancyValue) - 2)

            'All the fields are writing correctly to the table but the the 2 listboxes (ContractorIssues lstContractorIssues) (VACReason lstVacancyReason)
            With rs  '<<--!!!!
                .AddNew
                .Fields("Analyst") = Me.cboAnalyst.Value
                .Fields("ReportDate") = Me.txtReportDate.Value
                .Fields("ContractNumber") = Me.cboContractNumber.Column(0)
                .Fields("Contractor") = Me.txtContractor.Value
                .Fields("MATO") = Me.txtMATO.Value
                .Fields("ContractorOnset") = Me.txtContractorOnset.Value
                .Fields("ContractorResolved") = Me.txtContractorResolved.Value
                .Fields("ContractorComments") = Me.txtContractorComments.Value
                .Fields("ContractorIssues") = issuesValue        'Not writing to tbl
                .Fields("VACTO") = Me.cboTOvac.Value
                .Fields("VACCLIN") = Me.cboCLINvac.Column(2)
                .Fields("VACCOR") = Me.txtCORVAC.Value
                .Fields("VACMTF") = Me.txtMTFVAC.Value
                .Fields("VACLabor") = Me.txtLaborvac.Value
                .Fields("VACSite") = Me.txtSiteVAC.Value
                .Fields("VACClinic") = Me.txtClinicalVAC.Value
                .Fields("VACIndcov") = Me.txtIndCovVAC.Value
                .Fields("MissedHours") = Me.txtIndHours.Value
                .Fields("MissedShifts") = Me.txtCovHours.Value
                .Fields("TOStart") = Me.txtTOStart.Value
                .Fields("TOEnd") = Me.txtTOEnd.Value
                .Fields("VACFrom") = Me.txtVacFrom.Value
                .Fields("VACTo") = Me.txtVacTo.Value
                .Fields("VACReason") = vacancyValue      'Not writing to tbl
                .Fields("VACComments") = Me.txtVACComments.Value
                .Update
            End With '<<--!!!!
        End If
    End If

ErrorHandler_Exit:
    On Error Resume Next
    rs.Close
    Set rs = Nothing    '    Set rst = Nothing  '<< RST?????
    Set db = Nothing
    Exit Sub

ErrorHandler:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Workdays"
    Resume ErrorHandler_Exit

End Sub

Biggest thing wrong was that the "With rs ... End with" was missing

Things I added/changed are in BLUE...
I also added "Me." to the beginning of the control names on the form

[PinkLady50]

Thanks so much to Dave and Steve for all your help.
I copied all the updated code but it error'd on

Dim db As DAO.Database - 'User defined type not defined'

[ssanfu]

Do you have a reference set for
"Microsoft Access 14.0 Object Library"?

If that doesn't fix the error, try setting a reference to
"Microsoft Office 14.0 Access database engine Object Library".