Как автоматически обновить лист Excel, чтобы инициировать отправку электронной почты на основе значения ячейки в VBA? - PullRequest
0 голосов
/ 28 января 2020

Как я могу заставить свой Excel лист генерировать автоматические электронные письма, когда значение ячейки становится 45?

Для этого я создал 2 книги Excel. Первый (Рабочая тетрадь-1) содержит столбец, в котором вычисляется фактическое количество дней, оставшихся до определенного события (дата события - Сегодня ()). Второй (Workbook-2) имеет тот же столбец, но он просто берет эти значения из (Workbook-1).

Цель (Рабочая тетрадь-2) - собрать наиболее важные данные, которые будут использоваться в электронной почте. Например, если на сегодняшний день оставшееся число дней составляет 46, завтра оно будет автоматически обновлено в обеих книгах и станет 45. Здесь я хочу, чтобы вторая книга инициировала отправку электронной почты без моего дальнейшего вмешательства.

Я подготовил приведенный ниже код (для Рабочей книги-2), и он фактически работает со мной, но только в 2 случаях: 1) когда я вручную копирую и вставляю формулу в соответствующую ячейку, значение которой уже составляет 45; 2) когда я выбираю соответствующую ячейку и нажимаю Enter в строке формул.

Ни один из этих вариантов мне не подходит, так как идея заключалась в том, чтобы автоматизировать процесс.

Вот код:

Dim xRg As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("H2:H75"), Target)

    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value = 45 Then
        Call Mail_small_Text_Outlook(Target)
    End If
End Sub

Sub Mail_small_Text_Outlook(val)
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim xMailSubject As String
    Dim xMailTo As String
    Dim xMailCc As String

    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)

    xMailBody = "<b>Dear </b>" & "<b>" & val.Offset(0, -1).Value & "</b>" & "<b>!</b>" & "<br /><br />" & _
        "Hereby please be kindly informed, that the following offer will expire on " & "<span style='font-weight:bold'>" & val.Offset(0, -2).Value & "</span>" & "," & " that is, after " & val.Offset(0, 0).Value & " days from the date of this email." 

    xMailSubject = val.Offset(0, 1).Value
    xMailTo = val.Offset(0, 2).Value
    xMailCc = val.Offset(0, 3).Value

    On Error Resume Next
    With xOutMail
        .To = xMailTo
        .CC = xMailCc
        .BCC = ""
        .Subject = xMailSubject
        .HTMLBody = xMailBody
        .Display   
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

Между тем, я прочитал много статей по этому вопросу, большинство из них рекомендуют использовать Application.Volatile метод заставить Excel пересчитать значения целевых ячеек (в моем случае только один столбец), другие рекомендуют принудительно обновлять Excel каждую секунду. В конечном счете, большинство из них не являются всеобъемлющими. Так какой из них наиболее подходит для моего конкретного случая?

1 Ответ

0 голосов
/ 28 января 2020

Я думаю, ваша проблема в том, что ничего не вызывает Application.Calculation. Формула Today() Excel не возвращает новую дату, если рабочая книга открыта, и ничто не обязывает Excel вычислять. Итак, я бы предложил вам использовать событие Workbook_Open() для вызова, в указанное c время, функции, которая изменит дату, заставляя Excel cu вычислять (если Application.Calculation = xlCalculationAutomatic). Тогда обсуждаемая функция рекурсивно сработает, устанавливая следующий рабочий режим:

Private Sub Workbook_Open()
    Application.Calculation = xlCalculationAutomatic
    Application.OnTime TimeSerial(0, 0, 0), "Date_Change"
End Sub

Sub Date_Change()
    Dim sh As Worksheet
    Set sh = ActiveSheet ' use here your sheet
    sh.Range("A2").Value = Date
    '"programming" the function to act nex time/day
    Application.OnTime TimeSerial(0, 0, 0), "Date_Change"
End Sub

Значение диапазона «A2» (или любой другой диапазон, который вы выберете) должно быть основой для вычислений для этого значения, способного вызвать функцию отправки почты.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...