问题
I have a scenario where in I have to save "STATUS" code into table from a "COMBO BOX". This Combo Box shows "Status ID" and "Status Description" together. But while saving I need to save only "Status ID"
Following is the code for the complete form functionality. Error is occurring on click of "SAVE" button. On line where I am assigning the value from combo to "Recordset Column" on line # 77 or 90.
' rs![status_ID] = Me.cboStatus.Column(1)
Option Compare Database
Option Explicit
Dim db As Database
Dim rs, rs2, rs3 As Recordset
Dim SQL, SQL1, SQL2 As String
Dim intChk As Integer
Private Sub btnFirst_Click()
If Not rs.BOF Then
rs.MoveFirst
Set_Data
End If
If rs.EOF Then
rs.MovePrevious
End If
End Sub
Private Sub btnLast_Click()
If Not rs.EOF Then
rs.MoveLast
Set_Data
End If
If rs.EOF Then
rs.MovePrevious
End If
End Sub
Private Sub btnNew_Click()
SQL2 = "select Max(job_ID) as JID from tbl_mst_JobOrder"
Set rs3 = CurrentDb.OpenRecordset(SQL2, dbOpenDynaset, dbSeeChanges)
If Not rs3.EOF And Not rs3.BOF Then
Me.txtJobID = rs3!JID + 1
End If
Set rs3 = Nothing
TxtSetEmpty
End Sub
Private Sub btnNext_Click()
If Not rs.EOF Then
rs.MoveNext
Set_Data
End If
If rs.EOF Then
rs.MovePrevious
End If
End Sub
Private Sub btnPrevious_Click()
If Not rs.BOF Then
rs.MovePrevious
Set_Data
End If
If rs.BOF Then
rs.MoveNext
End If
End Sub
Private Sub btnSave_Click()
Dim SQL As String
IfEmpty
Dim sqlShift As String
If intChk = 1 Then
intChk = 0
Exit Sub
Else
SQL = "select job_ID from qryJobDetails " _
& "where job_ID = " & Me.txtJobID
Set rs2 = CurrentDb.OpenRecordset(SQL)
If Not rs2.EOF Then
Dim CHK As String
Me.lblChk.Caption = rs2![job_ID]
End If
Set rs2 = Nothing
If Me.txtJobID.Value = Me.lblChk.Caption Then
Dim msgUpd, msgNew, strCobSt As String
strCobSt = Me.cboStatus.Column(1)
msgUpd = "Do you want to update Location ID " & Me.lblChk.Caption
If MsgBox(msgUpd, vbYesNo, "Location Update") = vbYes Then
rs.Edit
rs![job_Date] = Me.dtpJDate.Value
rs![job_Desc] = Me.txtJobDesc
rs![loc_ID] = Me.txtLocID
rs![status_ID] = Me.cboStatus.Column(1)
rs![Comments] = Me.txtComment
rs.Update
RefreshListBox
End If
Else
msgNew = "Do you want to add New Location"
If MsgBox(msgNew, vbYesNo, "Add New Location") = vbYes Then
rs.AddNew
rs![job_ID] = Me.txtJobID
rs![job_Date] = Me.dtpJDate.Value
rs![job_Desc] = Me.txtJobDesc
rs![loc_ID] = Me.txtLocID
rs![status_ID] = Me.cboStatus.Column(1)
rs![Comments] = Me.txtComment
rs.Update
RefreshListBox
End If
End If
End If
End Sub
Private Sub Form_Load()
Set db = CurrentDb
SQL = "Select status_ID, status_Desc from tbl_mst_Status order by status_ID"
Set rs2 = db.OpenRecordset(SQL)
Do Until rs2.EOF
Me.cboStatus.AddItem rs2![status_ID] & "|" & rs2![status_Desc]
rs2.MoveNext
Loop
Set rs2 = Nothing
Set rs = db.OpenRecordset("qryJobDetails", dbOpenDynaset, dbSeeChanges)
RefreshListBox
Set_Data
End Sub
Private Sub Set_Data()
If Not rs.BOF And Not rs.EOF Then
Me.txtJobID = rs![job_ID]
Me.dtpJDate = rs![job_Date]
Me.txtJobDesc = rs![job_Desc]
Me.txtLocID = rs![loc_ID]
Me.txtLocDec = rs![location_desc]
Me.cboStatus = rs![status_ID] & "|" & rs![status_Desc]
Me.txtComment = rs![Comments]
End If
End Sub
Private Sub RefreshListBox()
Me.lstJobOrd.RowSource = ""
Me.lstJobOrd.AddItem "Job Order" & ";" & "Job Date" & ";" & "Job Description" & ";" _
& "Loc Description" & ";" & "Loc ID" & ";" & "Sta ID" & ";" _
& "Sta Desc" & ";" & "Comments"
rs.MoveFirst
Do Until rs.EOF
Me.lstJobOrd.AddItem rs![job_ID] & ";" & rs![job_Date] & ";" & rs![job_Desc] & ";" _
& rs![location_desc] & ";" & rs![loc_ID] & ";" & rs![status_ID] & ";" _
& rs![status_Desc] & ";" & rs![Comments]
rs.MoveNext
Loop
rs.MoveFirst
End Sub
Private Sub TxtSetEmpty()
Me.txtJobDesc = ""
Me.dtpJDate = Now()
Me.txtLocDec = ""
Me.cboStatus = ""
Me.txtComment = ""
Me.txtLocID = ""
End Sub
Private Sub lstJobOrd_Click()
With Me.lstJobOrd
Me.txtJobID.Value = .Column(0)
Me.dtpJDate.Value = .Column(1)
Me.txtJobDesc.Value = .Column(2)
Me.txtLocDec.Value = .Column(3)
Me.txtLocID.Value = .Column(4)
Me.cboStatus.Value = .Column(5)
Me.txtComment.Value = .Column(7)
End With
End Sub
Private Sub IfEmpty()
Dim txtCtr As Control
Dim cboCtr As Control
Dim Str As String
Str = Empty
For Each txtCtr In Me.Controls
If TypeOf txtCtr Is TextBox Then
If IsNullOrEmpty(txtCtr) Then
txtCtr.BackColor = RGB(119, 192, 212)
txtCtr.BorderColor = RGB(157, 187, 97)
Str = Str & txtCtr.Tag & vbNewLine
Else
txtCtr.BackColor = vbWhite
txtCtr.BorderColor = RGB(192, 192, 192)
End If
End If
Next txtCtr
For Each cboCtr In Me.Controls
If TypeOf cboCtr Is ComboBox Then
If IsNullOrEmptyCbo(cboCtr) Then
cboCtr.BackColor = RGB(119, 192, 212)
cboCtr.BorderColor = RGB(157, 187, 97)
Str = Str & cboCtr.Tag & vbNewLine
Else
cboCtr.BackColor = vbWhite
cboCtr.BorderColor = RGB(192, 192, 192)
End If
End If
Next cboCtr
If IsNull(Str) Or Str = "" Then
Exit Sub
Else
MsgBox "Please enter data in the highlited fields. " & vbNewLine & _
String(52, "_") & vbCrLf & Str, vbInformation + vbOKOnly, "Data not Complete"
intChk = 1
Exit Sub
End If
End Sub
Private Sub txtLocDec_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 113 Then
DoCmd.OpenForm "frmLocSer", acNormal, , , acFormAdd, acWindowNormal
End If
End Sub`
来源：https://stackoverflow.com/questions/59752046/error-3421-data-type-connection-error-multy-column-combobox