Исправление этого сценария «Отправлено по электронной почте»?

Хотя я абсолютно ничего не знаю о VBA, я прочитал около десятка тем по этому вопросу в нескольких сообществах, пытаясь выяснить что-то, способ сделать это.

Я нашел сценарий, который наиболее вероятно работал в моем случае, проанализировал его, переключил ссылки, ячейки и так далее. Я думаю, что я приближаюсь к чему-то функциональному, увы, я боюсь, что это насколько мне известно, Trials & Errors.

Сценарий в настоящий момент ничего не делает … В E5-E35 указаны даты, ячейка рядом с каждой из этих ячеек содержит значение «Отправлено» и «Не отправлено», поэтому он не отправляет дубликаты писем.

Это на листе, который нужно запустить:

Option Explicit Private Sub Worksheet_Calculate() Dim FormulaCell As Range Dim FormulaRange As Range Dim NotSentMsg As String Dim MyMsg As String Dim SentMsg As String Dim MyLimit As Double NotSentMsg = "Not Sent" SentMsg = "Sent" 'Above the MyLimit value it will triger the email MyLimit = Today() Set FormulaRange = Me.Range("E5:E35") On Error GoTo EndMacro: For Each FormulaCell In FormulaRange.Cells With FormulaCell If IsNumeric(.Value) = False Then MyMsg = "Not numeric" Else If .Value > MyLimit Then MyMsg = NotSentMsg If .Offset(0, 1).Value = NotSentMsg Then strTO = "[email protected]" strCC = "" strBCC = "" strSub = "Greetings, " & Cells(FormulaCell.Row, "B").Value strBody = "Hi Sir " & vbNewLine & vbNewLine & _ "This email is to notify that you need to do your task : " & Cells(FormulaCell.Row, "B").Value & _ vbNewLine & vbNewLine & "Regards, Yourself" If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg ' Call Mail_with_outlook2 End If Else MyMsg = NotSentMsg End If End If Application.EnableEvents = False .Offset(0, 1).Value = MyMsg Application.EnableEvents = True End With Next FormulaCell ExitMacro: Exit Sub EndMacro: Application.EnableEvents = True MsgBox "Some Error occurred." _ & vbLf & Err.Number _ & vbLf & Err.Description End Sub 

И это модуль, который я использую для отправки электронных писем:

 Option Explicit Public FormulaCell As Range Public strTO As String Public strCC As String Public strBCC As String Public strSub As String Public strBody As String Public strAttach As String Public Function sendMail(strTO As String, strSub As String, strBody As String, Optional strCC As String, Optional strBCC As String, Optional strAttach As String) As Boolean Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error GoTo errorMail With OutMail .To = strTO If Len(Trim(strCC)) > 0 Then .CC = strCC If Len(Trim(strBCC)) > 0 Then .BCC = strBCC .Subject = strSub .Body = strBody If Len(Trim(strAttach)) > 0 Then If Dir(strAttach, vbNormal) <> "" Then .Attachments.Add (strAttach) End If .Send End With sendMail = True exitFunction: Err.Clear On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Exit Function errorMail: MsgBox "Some Error occurred." _ & vbLf & Err.Number _ & vbLf & Err.Description GoTo exitFunction End Function 

Большое спасибо за любую помощь, оказанную этой огромной задаче!

Можете ли вы попробовать следующий код, отлаживая шаг за шагом? Если есть ошибка, нажмите debug и прокомментируйте, какая строка получает какую ошибку. Мне было бы интересно узнать, приблизит ли это вас к месту назначения.

 Private Sub Worksheet_Calculate() Dim FormulaCell As Range Dim FormulaRange As Range Dim NotSentMsg As String Dim MyMsg As String Dim SentMsg As String Dim MyLimit As Date NotSentMsg = "Not Sent" SentMsg = "Sent" MyLimit = Date Set FormulaRange = Me.Range("E5:E35") 'On Error GoTo EndMacro: For Each FormulaCell In FormulaRange.Cells With FormulaCell If (IsDate(.Value) = True) Then If (.Value > MyLimit) Then If .Offset(0, 1).Value = NotSentMsg Then strTO = "[email protected]" strCC = "" strBCC = "" strSub = "Greetings, " & Cells(FormulaCell.Row, "B").Value strBody = "Hi Sir " & vbNewLine & vbNewLine & _ "This email is to notify that you need to do your task : " & Cells(FormulaCell.Row, "B").Value & _ vbNewLine & vbNewLine & "Regards, Yourself" Call sendMail(strTO, strSub, strBody, strCC) MyMsg = SentMsg End If Else MyMsg = NotSentMsg End If End If Application.EnableEvents = False .Offset(0, 1).Value = MyMsg Application.EnableEvents = True End With Next FormulaCell 'EndMacro: 'Application.EnableEvents = True 'MsgBox "Some Error occurred." _ ' & vbLf & Err.Number _ ' & vbLf & Err.Description End Sub 

Хорошие новости! Сценарий ниже работает правильно с моим документом. Хотя он отправляет электронную почту только для задач, у которых еще осталось время! Мне нужен скрипт для отправки электронной почты только тогда, когда дата будет такой же, как «Сегодня ()« Как мне это сделать?

Довольно уверен, что это связано с линией «Мой лимит = дата», но как мне изменить дату, чтобы включить только текущий день?

 Option Explicit Private Sub Worksheet_Calculate() Dim FormulaCell As Range Dim FormulaRange As Range Dim NotSentMsg As String Dim MyMsg As String Dim SentMsg As String Dim MyLimit As Double NotSentMsg = "Not Sent" SentMsg = "Sent" 'Above the MyLimit value it will triger the email MyLimit = Date Set FormulaRange = Me.Range("E5:E35") On Error GoTo EndMacro: For Each FormulaCell In FormulaRange.Cells With FormulaCell If .Value > MyLimit Then MyMsg = NotSentMsg If .Offset(0, 1).Value = NotSentMsg Then strTO = "[email protected]" strCC = "[email protected]" strBCC = "" strSub = "Greetings " & Cells(FormulaCell.Row, "B").Value strBody = "Hi Sir, " & vbNewLine & vbNewLine & _ "This email is to notify that you need to do your task : " & Cells(FormulaCell.Row, "B").Value & _ vbNewLine & vbNewLine & "Regards, Yourself" If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg ' Call Mail_with_outlook2 End If Else MyMsg = NotSentMsg End If Application.EnableEvents = False .Offset(0, 1).Value = MyMsg Application.EnableEvents = True End With Next FormulaCell ExitMacro: Exit Sub EndMacro: Application.EnableEvents = True MsgBox "Some Error occurred." _ & vbLf & Err.Number _ & vbLf & Err.Description End Sub 
  • Сценарий приложения Gmail Добавить BCC из таблицы
  • Электронная почта из Excel не отправит вложение
  • Excel VBA - отправить электронную почту через CDO.message - не удается добавить вложение
  • Гиперссылка для запуска макроса в personal.xlsb
  • Встраивать графики Excel в тело электронной почты с помощью perl
  • макрос для отправки писем с выбранным диапазоном (только строки, которые соответствуют условию if)
  • Как фильтровать unflagged элементы в Outlook с помощью vba
  • Ошибка отправки конверта в excel vba
  • Экспорт электронной почты из подпапки Outlook в Excel
  • Outlook VBA для сохранения вложения из почты, а затем скопировать данные вложения в другое Excel и отправить send excel по почте
  • VBA Excel. Если ячейка в одном столбце содержит адрес электронной почты, а ячейка в другом столбце - «SOLD», отправьте электронное письмо
  • Interesting Posts

    Динамически извлекать список уникальных значений из диапазона столбцов в Excel?

    Python – выберите последний файл со специальной стартовой строкой и расширением

    Восстановить файлы, которые были открыты на диске USB после его удаления.

    Чтение двойников из Excel «путь Excel»

    Использование значения ячейки для установки цены в другой ячейке

    VBA Проверка ячейки для изменения

    Сортировка словаря, который экспортируется в Excel?

    VBA Excel File Open Prompt Отменить ошибку

    Power pivot – Рассчитать итоговое значение из меры и повторить его в столбце

    Развернуть начальную дату до конца даты с помощью серии EOMONTH

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

    Excel: как я могу назвать «активную ячейку» ячейке

    VLOOKUP Возвращает пустое значение, если ошибка

    Как использовать varible для управления дорожкой для книги в VBA

    Сохранение листа Excel в текущем каталоге с помощью VBA

    Давайте будем гением компьютера.