VBA没有清除循环值

Question

我有一个VBA循环，可根据校准日期与当前日期检查何时需要执行校准。它在大多数情况下都可以正常工作，但是会在不需要的地方发送电子邮件。我认为VBA保存先前值的方式有问题。

我尝试打开和关闭excel文档并刷新它。

Sub emailnotice()


'THIS CODE CHECKS THE NEXT CALIBRATION DATE FROM RANGE E3 TO E39 AND CHECKS IT AGAINST THE CURRENT DAY.
'IF THE NEXT DATE IS LESS THAN THE CURRENT DATE THIS CODES SENDS AN EMAIL

Dim cal_date As Range
Dim values As String
Dim todaysdate As Date
Dim element As Range
Dim counter As Integer
Dim value_count As Integer

todaysdate = CDate(Sheets("Calibration").Range("B1")) 'CDate changes the value into Date format

'This allows tests to be added and removed
value_count = Sheets("Calibration").Range("G2").Value + 2
Rng = value_count

Set cal_date = Sheets("Calibration").Range("E3:E" & Rng) 'adjustable range based on count function
counter = 3

For Each element In cal_date

    'This block is effectively used to lookup values based on the current loop counter
    cellstep = "G" & counter
    procedure = "C" & counter
    procedure_step = Sheets("Calibration").Range(procedure).Value
    Item = "A" & counter
    item_step = Sheets("Calibration").Range(Item).Value

    If CDate(element) < todaysdate Then
        Sheets("Calibration").Range(cellstep).Value = "Fail"
        counter = counter + 1

        'THIS CODE IS FROM THE TEMPERATURE DATA EXCEL
        ' Use already open Outlook if possible
        On Error Resume Next
        Set OutlApp = GetObject(, "Outlook.Application")
        If Err Then
            Set OutlApp = CreateObject("Outlook.Application")
            IsCreated = True
        End If
        OutlApp.Visible = True
        On Error GoTo 0

        ' Prepare e-mail with PDF attachment
        With OutlApp.CreateItem(0)

            ' Prepare e-mail
            .Subject = procedure_step & " needs to be performed"
            .To = "fakeemail@email.com" ' <-- Put email of the recipient here
        ' .CC = "..." ' <-- Put email of 'copy to' recipient here
            .HTMLbody = "Hi," & "<br><br>" & _
                "Perform " & procedure_step & " for the " & item_step & "<br><br>" & _
                "<a href=""G:\SOILS\AMRL"">In-House Procedures</a>" & "<br><br> "
                '"Regards, " & Application.UserName
            '.Attachments.Add PdfFile

            ' Try to send
            On Error Resume Next
            .Send
            Application.Visible = True
            'If Err Then
            '  MsgBox "E-mail was not sent", vbExclamation
            'Else
            '  MsgBox "E-mail successfully sent", vbInformation
            'End If
            'On Error GoTo
        End With

  ' Delete PDF file
  'Kill PdfFile

  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit

  ' Release the memory of object variable
  Set OutlApp = Nothing


    Else
        Sheets("Calibration").Range(cellstep).Value = "Pass"
        counter = counter + 1

    End If

Next

Sheets("Calibration").Range("F2:F38").Value = values


End Sub

我希望此代码不发送不必要的校准电子邮件。