验证两个日期之间的月数，如果创建的日期是在15日之前或之后?

Question

我有一个数据库，其中包含一个用户输入表单，用于创建具有有效日期的订单。

创建日期在15日之前，生效日期为次月1日(当前月+1);创建日期在15日及之后，生效日期为次月1日(当前月+2)。

我希望VBA代码确定创建的日期是在15号之前还是之后，运行比较以确保有效日期是1或2个月提前，并显示一个异常消息，如果有效日期输入无效。

我的代码工作到上周，当我们有一个意外的中断和数据库关闭。现在，不管输入的有效日期是什么，它都会抛出异常消息:

Private Sub EffDue_AfterUpdate()
If Format(Me.PCCreated, "DD") < 15 Then

Dim CurrentDate As Date
Dim IntervalType As String
Dim Number As Integer
Dim EffDate As Date
IntervalType = "m"
Number = 1
CurrentDate = Me.PCCreated
EffDate = DateAdd(IntervalType, Number, CurrentDate)

ElseIf Format(EffDate, "MM") < Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") > Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") = Format(Me.EffDue, "MM") Then
Me.Text99 = ""
End If

If Format(Me.PCCreated, "DD") >= 15 Then

IntervalType = "m"
Number = 2
CurrentDate = Me.PCCreated
DateAdd(IntervalType, Number, CurrentDate) = EffDate

ElseIf Format(EffDate, "MM") < Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") > Format(Me.EffDue, "MM") Then
Me.Text99 = "Please review the effective due date"
ElseIf Format(EffDate, "MM") = Format(Me.EffDue, "MM") Then
Me.Text99 = ""
End If

If Format(Me.EffDue, "DD") > 1 Then
Me.Text99 = "The effective due date should be the 1st"
End If

End Sub

我的最新版本确定创建的日期是在15号之前还是之后，但它不能正确计算生效日期:

Private Sub EffDue_AfterUpdate()
Dim CurrentDay As Integer
Dim EffDate As Date
Dim CurrentMonth As Integer
Dim EffMonth As Integer

CurrentDay = DatePart("d", Me.PCCreated)
CurrentMonth = DatePart("m", Me.PCCreated)

If CurrentDay >= 15 Then
EffDate = DateAdd("M", 2, Me.PCCreated)
EffMonth = DatePart("m", EffDate)

ElseIf CurrentMonth > EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth < EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth = EffMonth Then
Me.Text95 = ""
End If

If CurrentDay < 15 Then

EffDate = DateAdd("M", 1, Me.PCCreated)
EffMonth = DatePart("m", EffDate)

ElseIf CurrentMonth > EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth < EffMonth Then
Me.Text95 = "The effective due date should be " & MonthName(EffMonth) & " 1st"
ElseIf CurrentMonth = EffMonth Then
Me.Text95 = ""
End If

If Day(Me.EffDue) > 1 Then
Me.Text95 = "The effective due date should be the 1st"
End If
End Sub

Answer 1

应该这样做:

Dim CreateDate As Date, EffCalc As Date
Dim mAdd As Long, msg As String

CreateDate = Me.PCCreated
mAdd = IIf(Day(CreateDate) <= 15, 1, 2) 'months to add

EffCalc = DateAdd("m", mAdd, CreateDate)               'add month(s)
EffCalc = DateSerial(Year(EffCalc), Month(EffCalc), 1) '1st of that month

If EffCalc <> Me.EffDue Then
msg = "Effective date should be " & Format(EffCalc, "mm/dd/yyyy")
End If
Me.Text99 = msg