How I can Setiing Limit Send Email Just Once VBA

[galihsaputra]

Hello master,

I have a project reminder VBA excel with send to Outlook.
I want send email just once when excel file opened first time,and if excel file closed and open again VBA excel can't send email again to outlook

This is my code :

Sub SendReminderMail()
 Dim OutLookApp As Object
 Dim OutLookMailItem As Object
 Dim iCounter As Integer
 Dim MailDest As String
 Dim FileExtStr As String
 Dim FileFormatNum As Long
 Dim Sourcewb As Workbook
 Dim Destwb As Workbook
 Dim TemFilePath As String
 Dim TempFileName As String
 
 With Application
      .ScreenUpdating = False
      .EnableEvents = False
 End With
 
 Set Sourcewb = ActiveWorkbook
 
 ' Next, copy the sheet to a new workbook.
 ' You can also use the following line, instead of using the ActiveSheet object,
 ' if you know the name of the sheet you want to mail :
 ' Sheets("Sheet5").Copy
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook
 'Determine the excel version, and file extension and format
 With Destwb
      If Val(Application.Version) < 12 Then
            'for excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
      Else
      'For excel 2007-2010, exit the subroutine if you answer
      ' NO in the security dialogue that is displayed when you copy
      ' a sheet from an .xlsm file with macros disabled.
            If Sourcewb.Name = .Name Then
                With Application
                   .ScreenUpdating = True
                   .EnableEvents = True
                End With
                MsgBox "You answered NO in the securiry dialog."
                Exit Sub
             Else
                    Select Case Sourcewb.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                            If .HasVBProject Then
                                FileExtStr = ".xlsm": FileFormatNum = 52
                            Else
                                FileExtStr = ".xlsx": FileFormatNum = 51
                            End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                    End Select
              End If
        End If
    End With
    
    ' You can use the following statements to change all cells in the
   ' worksheet to values.
    '    With Destwb.Sheets(3).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False
    ' Save the new workbook, mail, and then delete it.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy h-mm-ss")
    
 Set OutLookApp = CreateObject("Outlook.Application")
 Set OutLookMailItem = OutLookApp.CreateItem(0)
 
With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        
       ' Change the mail address and subject in the macro before
       ' running the procedure.
        On Error Resume Next
        With OutLookMailItem
            MailDest = [EMAIL="bams@gmail.com"]bams@gmail.com[/EMAIL] 'email destination
                For iCounter = 1 To WorksheetFunction.CountA(Columns(4))
                    If MailDest = "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
                        MailDest = Cells(iCounter, 4).Value
                    ElseIf MailDest <> "" And Cells(iCounter, 4).Offset(0, -1) = "Send Reminder" Then
                         MailDest = MailDest & ";" & Cells(iCounter, 4).Value
                    End If
                Next iCounter
         
            'isi email
            .Cc = MailDest
             .Subject = "Reminder Monitoring Lot"
             .Body = "Check Your Monitoring Lot Date."
             .Attachments.Add Destwb.FullName
            ' You can add other files by uncommenting the following statement.
            '.Attachments.Add ("C:\test.txt")
            ' In place of the following statement, you can use ".Display" to
            ' display the mail.
             .Send
         End With
         On Error GoTo 0
         .Close SaveChanges:=False
End With
    
    ' Delete the file after sending.
    Kill TempFilePath & TempFileName & FileExtStr
 Set OutLookMailItem = Nothing
 Set OutLookApp = Nothing
 
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
 End Sub
Private Sub Workbook_Open()
  Worksheets("Monitoring List CKD NSeries").Select
  For Each cell In Range("B7:B1994") 'range cell

  If cell.Value = Date + 3 Then
    'setting warna sesuai cell
    Cells(3, 2).Interior.ColorIndex = 3
    Cells(3, 2).Font.ColorIndex = 1
    Range("B3").Value = cell.Value 'menampilkan tanggal yang sesuai dengan tanggal hari ini +3
    Application.Speech.Speak ("send reminder")
    Application.Speech.Speak (cell.Offset(0, -1).Value)
    
   End If
 Next
 SendReminderMail
 
End Sub

thanks a lot before