Microsoft Access: добавление текстового поля, поля со списком и способ, в котором, если запись не введена, она все равно будет работать
Я работал над проектом в качестве добровольного аналитика преступлений, и у меня возникли вопросы о том, как ввести в несколько текстовых полей многозначное поле со списком и как убедиться, что, если нет записей, эти поля игнорируется в пользу тех, которые имеют ценности в них. Я выяснил, как сделать так, чтобы несколько списков со множественным выбором возвращали данные из таблицы ввода данных, я прошу помощи о том, как добавить остальные компоненты, которые находятся в форме MS Access, которую я имею для база данных прототипов.
Вот мой код, хотелось бы получить несколько советов о том, как и куда будет идти код для текстовых полей и многозначного поля со списком
Private Sub Command62_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strCriteria1 As String
Dim strCriteria2 As String
Dim strCriteria3 As String
Dim strCriteria4 As String
Dim strCriteria5 As String
Dim strSQL As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("qryMultiselect")
For Each varItem In Me!District.ItemsSelected
strCriteria = strCriteria & ",'" & Me!District.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything in the Contract field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
For Each varItem In Me!MOMethodofEntry.ItemsSelected
strCriteria1 = strCriteria1 & ",'" & Me!MOMethodofEntry.ItemData(varItem) &
"'"
Next varItem
If Len(strCriteria1) = 0 Then
MsgBox "You did not select anything in the Name field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria1 = Right(strCriteria1, Len(strCriteria1) - 1)
For Each varItem In Me!MOLocation.ItemsSelected
strCriteria2 = strCriteria2 & ",'" & Me!MOLocation.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria2) = 0 Then
MsgBox "You did not select anything in the Name field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria2 = Right(strCriteria2, Len(strCriteria2) - 1)
For Each varItem In Me!MOPointofEntry.ItemsSelected
strCriteria3 = strCriteria3 & ",'" & Me!MOPointofEntry.ItemData(varItem) &
"'"
Next varItem
If Len(strCriteria3) = 0 Then
MsgBox "You did not select anything in the Name field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria3 = Right(strCriteria3, Len(strCriteria3) - 1)
For Each varItem In Me!CircumstanceCode.ItemsSelected
strCriteria4 = strCriteria4 & ",'" & Me!CircumstanceCode.ItemData(varItem) &
"'"
Next varItem
If Len(strCriteria4) = 0 Then
MsgBox "You did not select anything in the Name field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria4 = Right(strCriteria4, Len(strCriteria4) - 1)
For Each varItem In Me!MOWeapon.ItemsSelected
strCriteria5 = strCriteria5 & ",'" & Me!MOWeapon.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria5) = 0 Then
MsgBox "You did not select anything in the Contract field." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria5 = Right(strCriteria5, Len(strCriteria5) - 1)
strSQL = "SELECT * FROM tblDataEntry " & _
"WHERE tblDataEntry.District IN(" & strCriteria & ") AND
tblDataEntry.MOMethodofEntry IN(" & strCriteria1 & ") AND
tblDataEntry.MOLocation IN(" & strCriteria2 & ") AND
tblDataEntry.MOPointofEntry IN (" & strCriteria3 & ") AND
tblDataEntry.CircumstanceCode IN (" & strCriteria4 & ") AND
tblDataEntry.MOWeapon IN(" & strCriteria5 & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "qryMultiselect"
Set db = Nothing
Set qdf = Nothing
End Sub
Также, пожалуйста, дайте мне знать, если я делаю что-то не так. Еще немного нового для этого.
1 ответ
Я не уверен, что вы имеете в виду под "где будет код для текстовых полей и многозначных полей со списком", но я могу помочь вам в написании лучшего кода. Поместите в вашу форму эти функции:
Private Function GetSelectedItems(combo As ListBox) As String
Dim result As String
Dim n As Integer
With combo
For n = .ListCount - 1 To 0 Step -1
If .Selected(n) Then
result = result & ",'" & .ItemData(n) & "'"
End If
Next n
End With
GetSelectedItems = Mid(result, 2)
End Function
Public Function IsEmptyOrNull(strValue As Variant) As Boolean
If Trim(strValue) = vbNullString Or IsNull(strValue) Then
IsEmptyOrNull = True
End If
End Function
и чем вы вызываете функцию следующим образом:
strCriteria = GetSelectedItems(Me!District)
strCriteria1 = GetSelectedItems(Me!MOMethodofEntry)
…
После того, как вы заполните все свои критерии, создайте строку strFilter:
If Not IsEmptyOrNull(strCriteria) Then
strFilter = IIf(Not IsEmptyOrNull(strFilter), strFilter & " AND ", "") & " District IN (" & strCriteria & ")"
End If
If Not IsEmptyOrNull(strCriteria1) Then
strFilter = IIf(Not IsEmptyOrNull(strFilter), strFilter & " AND ", "") & " MOMethodofEntry IN (" & strCriteria1 & ")"
End If
…
Нечто подобное делает с вашими текстовыми полями:
If Not IsEmptyOrNull(Me.txtCaseNumber) Then
strFilter = IIf(Not IsEmptyOrNull(strFilter), strFilter & " AND ", "") & " CaseNumber= '" & Me.txtCaseNumber & "'"
End If
и после того, как вы добавите все свои поля, создайте строку strSQL:
strSQL = "SELECT * FROM tblDataEntry WHERE " & strFilter