Selbe Hilfe zum letzten Beitrag

Question

Wie sende ich E-Mail-Erinnerungen zwei Wochen vor dem Abgabedatum? Unten ist mein SQL-Code aus einer Abfrage.

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")); 

Dies ist meine E-Mail-Erinnerung. Ich möchte nur einen Code einfügen, der eine E-Mail-Erinnerung 2 Wochen vor dem Lead-Date sendet.

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

Sie sich von diesem Wenn los und Matching Endif

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

Ändern Sie diese

' 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 

Zu diesem

' 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