Welcome to WuJiGu Developer Q&A Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
3.3k views
in Technique[技术] by (71.8m points)

Validating number of months between two dates if created date is before or after the 15th in Access VBA

I have a database with a user entry form that allows the end user to create an order with an effective date. The effective date is the 1st of the next month (current month +1) if the creation date is before the 15th, or the 1st of the following month (current month +2) if the creation date is the 15th or later. I would like the VBA code to determine if the created date is before or after the 15th, run a comparison to make sure the effective date is either 1 or 2 months ahead as appropriate, and show an exception message if the effective date input is not valid.

My original code worked up until last week, when we had an unexpected outage and the database shut down. Now it throws up the exception message regardless of the effective date input:

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

My latest revision correctly identifies if the created date is before or after the 15th, but it doesn't correctly calculate the effective date:

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

I'm sure I'm overlooking something simple and I'll kick myself once someone points it out. Any help would be much appreciated!


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

Something like this should work:

    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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to WuJiGu Developer Q&A Community for programmer and developer-Open, Learning and Share
...