Есть ли способ, чтобы появилось окно сообщения с кнопкой, чтобы открыть шаблон электронной почты?

Question

Добрый день,

У меня есть код ниже, который срабатывает, когда появляется ячейка в указанном диапазоне, сообщая человеку, что он должен делать. Что мне теперь нужно сделать, так это, во-первых, чтобы это всплывающее окно появлялось только тогда, когда в указанный диапазон явно введена дата, во-вторых, мне также нужно, чтобы во всплывающем окне была кнопка, которая затем открывает новое сообщение электронной почты, которое автоматически заполняет Кому, CC, Предмет и Элементы тела.

Вот код, который у меня есть,

Private Sub Worksheet_change(ByVal Target As Range)

If Not Intersect(Target, Range("I7:I51")) Is Nothing Then
    MsgBox "You have entered a date in Attempt 3, you must now send an email to request a text message chaser, click the open email button below"  & Target, vbOKOnly, "Warning"

End If

End Sub

Answer 1

Чтобы проверить, является ли Target датой или нет, вам просто нужна функция IsDate:

Private Sub Worksheet_change(ByVal Target As Range)
    If Not Intersect(Target, Range("I7:I51")) Is Nothing Then
        If IsDate(Target) Then
            MsgBox "You have entered a date in Attempt 3, you must now send an email to request a text message chaser, click the open email button below" & Target, vbOKOnly, "Warning"
            Send_Emails
        End If
    End If
End Sub

Sub Send_Emails()
'This code is early binding i.e in Tools > Reference >You have check "MICROSOFT OUTLOOK 14.0 OBJECT LIBRARY"

    Dim OutlookApp As Outlook.Application
    Dim OutlookMail As Outlook.MailItem

    Set OutlookApp = New Outlook.Application
    Set OutlookMail = OutlookApp.CreateItem(olMailItem)

    With OutlookMail
        .BodyFormat = olFormatHTML
        .Display
        .HTMLBody = "Dear ABC" & "<br>" & "<br>" & "Please find the attached file" & .HTMLBody
        'last .HTMLBody includes signature from the outlook.
                                                   '<br> includes line breaks b/w two lines
        .To = "abc@gmail.com"
        .CC = "sdf@gamil.com"
        .BCC = "hello@gamil.com;hi@gmail.com"
        .Subject = "Test mail"
        .Attachments = ThisWorkbook
        .Send
    End With

End Sub

Что касается субмарины Send_Emails, у меня не было возможности проверить это (так как у меня нет перспективы), но вы можете настроить параметры, чтобы получить то, что вы хотите. Вы также можете включить To, CC и все поля в качестве параметров для передачи из основной подпрограммы Worksheet_change. Скажите, нужна ли вам помощь в этом отношении?