与上次发帖相同的帮助

Question

如何在无铅日期前2周发送电子邮件提醒？ 下面是我查询的SQL代码。

SELECT CalibrationRecord.RecordID, CalibrationRecord.CalRequirement, CalibrationRecord.CalStatus, 
CalibrationRecord.CalLocation, Equipment.EquipmentType, Equipment.SerialNo, Equipment.ModelNo, 
Equipment.AssetNo, CalibrationRecord.EmpName, Employees.EmailAddress, CalibrationRecord.LastCalDate, 
CalibrationRecord.CalTimeInterval, CalibrationRecord.UOM, 
DateAdd(IIf([CalibrationRecord]![UOM]="days","d",IIf([CalibrationRecord]![UOM]="month","m","yyyy")), 
[CalTimeInterval],[LastCalDate]) AS CalUpcomingDate, CalibrationRecord.DateEmailSent, 
DateAdd(IIf([Equipment]![UOM]="weeks","ww"),-[LeadInterval],[CalUpcomingDate]) AS LeadDate 
FROM Equipment INNER JOIN (Employees INNER JOIN CalibrationRecord ON Employees.EmpID = CalibrationRecord.EmpName) 
ON Equipment.ItemID = CalibrationRecord.EquipItemID 
WHERE (((CalibrationRecord.CalStatus)="Not Started") 
AND ((Employees.EmailAddress) Is Not Null) 
AND ((CalibrationRecord.CalTimeInterval) Between 6 And 9) 
AND ((CalibrationRecord.UOM) Like "month") 
AND ((Employees.EmpName) Not Like "MFGUSER")) OR (((CalibrationRecord.UOM) Like "days")); 

这是我的电子邮件提醒代码。我只想包含一段代码，可在引导日期前2周发送电子邮件提醒。

Function GenerateEmail(MySQL As String) 
    On Error GoTo Exit_Function: 
    Dim oOutLook As Outlook.Application 
    Dim oEmailAddress As MailItem 
    Dim MyEmpName As String 
    Dim MyEquip As String 
    Dim MyModel As String 
    Dim MyAsset As String 
    Dim MySerial As String 
    Dim rs As Recordset 
    Set rs = CurrentDb.OpenRecordset(MySQL) 
    If rs.RecordCount > 0 Then 
    rs.MoveFirst 
Do Until rs.EOF 

If Not IsNull(rs!EmailAddress) Then 

    ' Only Send Emails if never been sent before - or past 14 days since last one' 
    If (IsNull(rs!DateEmailSent)) Or DateDiff("d", rs!DateEmailSent, Date) >= 14 Then 

If rs!LeadDate - 2 * 7 <= Date Then **This is what i have so far for the 2 weeks prior to Lead Date** 

     If oOutLook Is Nothing Then 
      Set oOutLook = New Outlook.Application 
     End If 
     Set oEmailAddressItem = oOutLook.CreateItem(olMailItem) 

     With oEmailAddressItem 

      'MyEmpName = DLookup("EmpName", "Employees", "[EmpID]= " & rs!EmpName) 
      MyEquip = rs!EquipmentType 
      MyModel = rs!ModelNo 
      MyAsset = rs!AssetNo 
      MySerial = rs!SerialNo 
      .To = "dgaskins@eeimfg.com" 
      .Subject = "Monthly Calibrations" 
      .Body = "Calibration ID: " & rs!RecordID & vbCr & _ 
        "Location: " & rs!CalLocation & vbCr & _ 
        "Requirement: " & rs!CalRequirement & vbCr & _ 
        "Name: " & MyEquip & vbCr & _ 
        "Serial No.: " & MySerial & vbCr & _ 
        "Model No.: " & MyModel & vbCr & _ 
        "Asset No.: " & MyAsset & vbCr & _ 
        "Upcoming Date: " & rs!CalUpcomingDate & vbCr & vbCr & _ 
        "This email is auto generated. Please Do Not Reply!" 

     '.Display 
     .Send 

     ' Make sure to record that reminder was sent ' 
     rs.Edit 
     rs!DateEmailSent = Date 
     rs!LeadDate = DateAdd("ww", -2, Now) 
     rs.Update 
     End With 
     ' Only do this if this has been set ' 
     Set oEmailAddressItem = Nothing 
    End If 
End If 
End If 
rs.MoveNext 
Loop 

' Do this at end ' 
Set oOutLook = Nothing 
Else 
End If 
rs.Close 
Exit_Function: 
    Exit Function 
    End Function 

Answer 1

摆脱这个如果和匹配ENDIF

If DateDiff("d", Date, rs!LeadDate) Then **This is what i have so far for the 2 weeks prior to Lead Date** 

更改此

' Only Send Emails if never been sent before - or past 14 days since last one' 
If (IsNull(rs!DateEmailSent)) Or DateDiff("d", rs!DateEmailSent, Date) >= 14 Then 

为了这

' Only Send Emails if never been sent before 
' - or past 14 days since last one 
' - or with 14 days of LeadDate 
If (IsNull(rs!DateEmailSent)) Or DateDiff("d", rs!DateEmailSent, Date) >= 14 Or DateDiff("d", Date, rs!LeadDate) <= 14 Then