ارسال ایمیل پس از رسیدن به موعد مقرر

Question

دومینیک برگه ای دارد که تاریخ سررسید پروژه ها را در ستون E نشان می دهد. او می داند که می تواند از قالب بندی شرطی برای نشان دادن زمان رسیدن به سررسید (زمانی که با تاریخ امروز یکسان است) استفاده کند، اما چیزی که واقعاً به آن نیاز دارد یک ایمیل است. در زمان رسیدن به موعد مقرر ارسال شود. او فکر می کند که آیا راهی برای انجام این کار در اکسل وجود دارد؟

در واقع، راهی برای انجام این کار وجود دارد، مشروط بر اینکه از ماکرو استفاده نکنید. علاوه بر این، باید ایمیل را از طریق Outlook ارسال کنید، که VBA به خوبی با آن ارتباط برقرار می کند. (متاسفانه، VBA را نمی توان به راحتی برای ارتباط با سایر سرویس گیرندگان ایمیل استفاده کرد.)

به عنوان مثال، در اینجا یک ماکرو وجود دارد که هر زمان که ورک بوک شما باز شود اجرا می شود. به طور خودکار هر ردیف در یک کاربرگ را بررسی می کند، به طور خاص روی دو چیز کلید می زند: تاریخ سررسید در ستون E و یک "مقدار پرچم" در ستون F. (این مقدار پرچم توسط ماکرو تنظیم می شود. اگر ستون F حاوی حرف "S" باشد، سپس ماکرو فرض می کند که یک ایمیل قبلا ارسال شده است.)

Private Sub Workbook_Open()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim lLastRow As Long
    Dim lRow As Long
    Dim sSendTo As String
    Dim sSendCC As String
    Dim sSendBCC As String
    Dim sSubject As String
    Dim sTemp As String

    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

     Change the following as needed
    sSendTo = "allen@xyz.com"
    sSendCC = ""
    sSendBCC = ""
    sSubject = "Due date reached"

    lLastRow = Cells(Rows.Count, 3).End(xlUp).Row
    For lRow = 2 To lLastRow
        If Cells(lRow, 6) <> "S" Then
            If Cells(lRow, 5) <= Date Then
                Set OutMail = OutApp.CreateItem(0)

                On Error Resume Next
                With OutMail
                    .To = sSendTo
                    If sSendCC > "" Then .CC = sSendCC
                    If sSendBCC > "" Then .BCC = sSendBCC
                    .Subject = sSubject

                    sTemp = "Hello!" & vbCrLf & vbCrLf
                    sTemp = sTemp & "The due date has been reached "
                    sTemp = sTemp & "for this project:" & vbCrLf & vbCrLf
                     Assumes project name is in column B
                    sTemp = sTemp & "    " & Cells(lRow,2)
                    sTemp = sTemp & "Please take the appropriate"
                    sTemp = sTemp & "action." & vbCrLf & vbCrLf
                    sTemp = sTemp & "Thank you!" & vbCrLf

                    .Body = sTemp
                     Change the following to .Send if you want to
                     send the message without reviewing first
                    .Display
                End With
                Set OutMail = Nothing

                Cells(lRow, 6) = "S"
                Cells(lRow, 7) = "E-mail sent on: " & Now()
            End If
        End If
    Next lRow
    Set OutApp = Nothing
End Sub

هنگامی که ماکرو اجرا می شود (دوباره، زمانی که ورک بوک برای اولین بار باز می شود)، هر ردیف در کاربرگ را بررسی می کند تا ببیند آیا "S" در ستون F وجود دارد یا خیر. اگر نه، سپس بررسی می کند که آیا تاریخ در ستون E وجود دارد یا خیر. برابر با تاریخ امروز اگر اینطور است، کد یک پیام ایمیل (که می توانید آن را به دلخواه تغییر دهید) برای ارسال قرار می دهد. ایمیل نمایش داده می شود و پس از اعمال تغییرات دلخواه می توانید بر روی دکمه ارسال کلیک کنید. در آن مرحله، کاربرگ با قرار دادن نشانگر "S" در ستون F و تاریخ ارسال ایمیل در ستون G به روز می شود.

توجه داشته باشید که ماکرو فرض می کند که نام پروژه در ستون B است. از این اطلاعات برای کنار هم قرار دادن پیامی که ایمیل خواهد شد استفاده می شود.