Как создать триггер времени, который бы отправлял письма каждую неделю

Question

Я хотел бы попросить вас об услуге. Я получил электронную таблицу с кодом, который отправляет электронное письмо, если ячейка (I3) содержит текст «YES».

Обычно, если ячейка (J3) пуста, то (I3) возвращает значение «ДА», а затем код отправляет электронное письмо по адресам в ячейке (B3), как только это будет сделано, в ячейке появится дата (J3) и значение в (I3) меняется на «НЕТ». Поэтому в следующий раз код знает, что никакие электронные письма не нужно отправлять конкретному человеку.

Я получил этот код интернета. Сделана небольшая модификация кода под лист1. Я очень новичок в этом, пожалуйста, будьте терпеливы со мной.

В ячейке (C3) у меня есть дата начала, в ячейке (H3) дата окончания / окончания. Я хотел бы, чтобы моя таблица автоматически отправляла электронные письма, не открывая книгу. Я хотел бы, чтобы триггер времени отправлял электронные письма, если конкретное задание должно быть выполнено в течение 30 дней, и если электронное письмо может генерироваться каждый понедельник, пока оно не достигнет 0 дней, а затем одно электронное письмо с просрочкой - 5.

Не уверен, что ячейка (I3) или (J3) все еще может использоваться.

Надеюсь, я все объяснил ясно.

 Dim uRange
 Dim lRange
 Dim BCell As Range
 Dim iBody As String
 Dim iTo As String
 Dim iSubject As String
 Dim DaysOverdue

 Public Sub SetEmailParams()

 Set uRange = Sheet1.Range("I2")
 Set lRange = Sheet1.Range("I" & Rows.Count).End(xlUp)

 iBody = Empty
 iSubject = Empty
 iTo = Empty

 For Each BCell In Range(uRange, lRange)

 If BCell.Value = "YES" Then

 If DateDiff("d", Format(Now(), "dd/mm/yyyy"), Format(Range("G3"), 
"dd/mm/yyyy")) <= 0 Then

 DaysOverdue = DateDiff("d", Format(BCell.Offset(0, -6)), 
 Format(BCell.Offset(0, -1)))

 iTo = BCell.Offset(0, -7).Value
 iSubject = "Reminder"
 iBody = "The job assigned to you under this describtion - " & 
 BCell.Offset(0, -4) & " in the name of " & BCell.Offset(0, -3) & " for the 
 confirmation date of " & BCell.Offset(0, -1) & " is due " & DaysOverdue & " 
 days."

 SendEmail

 BCell.Offset(0, 1).Value = Now()

 End If

 End If

 Next BCell

 End Sub

 Private Sub SendEmail()

 Dim OutApp As Object
 Dim OutMail As Object
 Dim strbody As String

 Set OutApp = CreateObject("Outlook.Application")
 Set OutMail = OutApp.CreateItem(0)

 On Error Resume Next
 With OutMail
 .To = iTo
 .CC = ""
 .BCC = ""
 .Subject = iSubject
 .Body = iBody
 'You can add a file like this
 '.Attachments.Add ("C:\test.txt")
 .Send 'or use .Send to automatically send without displaying
 End With
 On Error GoTo 0

 Set OutMail = Nothing
 Set OutApp = Nothing

End Sub

Answer 1

Вы можете создать BAT FILE, который откроет эти рабочие книги, и когда рабочие книги откроются, запустите макрос Auto_Open, который считывает содержимое всех ячеек.

В ThisWorkbook напишите этот код:

Private Sub Workbook_Open()

    MsgBox "Welcome"

End Sub

Это пример файла BAT, о котором я упоминал ранее:

1.- Открыть блокнот

2.- Напишите это:

start Excel.exe "C:\Temporal\TEST.xlsm"

3.- Сохранить как MyBat.bat

4.- Перейдите в Панель управления -> Администрирование -> Планировщик задач -> Создать базовую задачу

5.- Установите время, когда вы хотите выполнить этот bat-файл!

Я надеюсь, что это работает для вас! Ура!

Answer 2

Ссылаясь на мои комментарии, ниже приведен пример использования Mail.DeferredDeliveryTime.Этот образец отправляет каждое электронное письмо с определенной темой в следующий понедельник в 8 часов утра.

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
  Dim Mail As Outlook.MailItem
  If TypeOf Item Is Outlook.MailItem Then
    Set Mail = Item
    If Mail.Subject = "sample" Then
      Mail.DeferredDeliveryTime = GetNextWeekday(vbMonday) & " 08:00 AM"
    End If
  End If
End Sub

Private Function GetNextWeekday(ByVal DayOfWeek As VbDayOfWeek) As Date
  Dim diff As Long
  diff = DayOfWeek - Weekday(Date, vbSunday)
  If diff > 0 Then
    GetNextWeekday = DateAdd("d", diff, Date)
  Else
    GetNextWeekday = DateAdd("d", 7 + diff, Date)
  End If
End Function

Answer 3

Для отправки автоматических писем вы можете использовать SendInBlue API или mail gun Для преобразования листов Excel используйте sheetjs

Я надеюсь, что это поможет