複数のスケジュールが重複する Access データベース テーブルがあります。重複する既存の時間範囲に直面して、Bu を作成するのは簡単だと思いました。ユーザーが 1 人の従業員のスケジュールを承認した場合。ユーザーが同じ従業員の時間と重複する次のスケジュールを承認するとき。ユーザーが重複するスケジュールを承認したときに警告メッセージを作成し、「承認済み」のテキストをテーブルから削除する必要があります。VBコードに関する知識があまりないか、クエリで設定できるものがあるかどうか。どんな助けでも大歓迎です。
2 に答える
OK、EmpID、StartTime、および EndTime の 3 つのフィールドを持つテーブルがあります。開始時刻と終了時刻には、日付と時刻が一緒に含まれています。
次に、同じ3つのフィールドを持つフォームがあります。
VBA コードでは、Before_Update イベントの下で、競合があるかどうかを確認し、競合がある場合は、Cancel プロパティを true に設定してメッセージを表示します。コードは次のとおりです。
Private Sub Form_BeforeUpdate(Cancel As Integer)
Dim RS As Recordset
Dim strSQL As String
Dim EmpID As Long
Dim ScheduleStart As String
Dim ScheduleEnd As String
EmpID = Me.txtEmpID
ScheduleStart = Me.txtStartTime
ScheduleEnd = Me.txtEndTime
strSQL = ""
strSQL = strSQL & "SELECT Count(schedule.EmpID) AS Conflict " & vbCrLf
strSQL = strSQL & "FROM schedule " & vbCrLf
strSQL = strSQL & "WHERE ( ( ( Schedule.EmpID ) = @EmpID ) " & vbCrLf
strSQL = strSQL & " AND ( ( #@ScheduleStart# ) <= [StartTime] ) " & vbCrLf
strSQL = strSQL & " AND ( ( #@ScheduleEnd# ) > [StartTime] ) ) " & vbCrLf
strSQL = strSQL & " OR ( ( ( Schedule.EmpID ) = @EmpID ) " & vbCrLf
strSQL = strSQL & " AND ( ( #@ScheduleStart# ) <= [EndTime] ) " & vbCrLf
strSQL = strSQL & " AND ( ( #@ScheduleEnd# ) > [EndTime] ) )"
strSQL = Replace(strSQL, "@EmpID", EmpID)
strSQL = Replace(strSQL, "@ScheduleStart", ScheduleStart)
strSQL = Replace(strSQL, "@ScheduleEnd", ScheduleEnd)
Debug.Print strSQL
Set RS = CurrentDb.OpenRecordset(strSQL)
If RS("Conflict") > 0 Then
Cancel = True
MsgBox "Conflict Detected", vbExclamation, "Conflict Detected"
End If
End Sub
これは、EmpID を使用する 2 つのシナリオを探します。
- ScheduleStart < StartTime AND ScheduleEnd > StartTimeの場合
- またはScheduleStart < EndTime AND ScheduleEnd > EndTime
ほとんどのコードは SQL を構築しています。パラメータクエリを使えばもっとすっきりするのですが、わかりやすいと思ったのでこのようにしました。
Debug.Print strSQL は、建物のクエリがどのように見えるかを示します。
これにはエラー チェックがないので、いくつか入力する必要があります。現在、日付を入力するときは、次のようにする必要があります: 6/26/13 4:31 pm
次のようなデータとフォームのサンプル セットを作成しました。
そして、このコードを競合ボタンに追加して、StartTime と StartDate が他のレコードの StartTime/StartDate と EndTime/EndDate の間にあるかどうかを確認しました。EndTime と EndDate が間に合わないことも確認するために、コードを少し変更する必要があります。
Private Sub Test_Button_Click()
Dim myR As Recordset
Dim strSQL As String
strSQL = "Select * From Sample Where " & _
"StartDate <= #" & Me.StartDate & "# " & _
"And StartTime <= #" & Me.StartTime & "# " & _
"And EndDate >= #" & Me.StartDate & "# " & _
"And EndTime >= #" & Me.StartTime & "#"
Debug.Print strSQL
Set myR = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
If myR.RecordCount = 0 Then
Debug.Print "There are no conflicts"
End If
Set myR = Nothing
End Sub