Отправлять напоминания по электронной почте пользователям по дате и времени дня - автоматически - PullRequest
Новая
       14

Отправлять напоминания по электронной почте пользователям по дате и времени дня - автоматически

0 голосов
/ 25 марта 2019

У меня есть контрольный список действий 1000 выше - каждая строка имеет разные время и дату в качестве крайнего срока. несколько пользователей будут выполнять действия, которые несут за них ответственность. Через электронную почту VBA соответствующему пользователю необходимо получить список действий на конечную дату и в то же время, что указано в Excel. Я создал vba на дату, и мне нужно запускать макрос вручную. Можно ли автоматически отправлять электронные письма по дате и дню?

Код VBA будет отправлять действия пользователям по дате - необходимо знать, как делать это автоматически по дате и времени 

Private Sub CommandButton12_Click()
'assign variables
 On Error GoTo ErrHandler:
'your code
ErrHandler: If Err.Number = 1004 Then
ErrMsg = Error(Err.Number)
MsgBox "No due activities as of today"
Exit Sub
End If

ThisWorkbook.Sheets("TodayData").Activate

    ThisWorkbook.Sheets("TodayData").Cells.Select
    Selection.Delete Shift:=xlUp
    Selection.Delete Shift:=xlUp

    ThisWorkbook.Activate
    ThisWorkbook.Sheets("Sheet1").Activate

    ThisWorkbook.Sheets("Sheet1").Range("A4").Select
    ThisWorkbook.Sheets("Sheet1").Range(Selection, Selection.End(xlToRight)).Select
    ThisWorkbook.Sheets("Sheet1").Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy

    ThisWorkbook.Sheets("TodayData").Activate
    ThisWorkbook.Sheets("TodayData").Range("A1").Select

    ActiveSheet.Paste
    ThisWorkbook.Sheets("TodayData").Cells.Select
    ThisWorkbook.Sheets("TodayData").Cells.EntireColumn.AutoFit
    ThisWorkbook.Sheets("TodayData").Range("D1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A:$I").AutoFilter Field:=4, Criteria1:= _
        "<>" & Date, Operator:=xlAnd

    With ThisWorkbook.Sheets("TodayData")
        lfilteredRows = .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
    End With

    If lfilteredRows > 1 Then
        ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
        ThisWorkbook.Sheets("TodayData").Range(Selection, Selection.End(xlDown)).Select
        'ThisWorkbook.Sheets("TodayData").Range(Selection, Selection.End(xlRight)).Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.ShowAllData
        ThisWorkbook.Sheets("TodayData").Range("I2").Select
    End If


    Dim rng As Range

    ThisWorkbook.Sheets("TodayData").Range("A1").Select
    Selection.End(xlDown).Select
    iRow = ActiveCell.Row
    Set rng = Nothing
    Set rng = ThisWorkbook.Sheets("TodayData").Range("A1:I" & iRow).SpecialCells(xlCellTypeVisible)




    strBody = "Dear Team,<br><br> Please find the below activities due for the day. Once it is completed please send update to respective Senior/Market owner or team leads.<br><br>"


    On Error GoTo debugs



    Set Mail_Object = CreateObject("Outlook.Application")
    'For i = 2 To iRow

    Set Mail_Single = Mail_Object.CreateItem(olMailItem)



    With Mail_Single
    .Subject = "PEC Activities due for the today - Iberia"
    .To = ThisWorkbook.Sheets("Sheet1").Range("L2").Value
    .cc = ThisWorkbook.Sheets("Sheet1").Range("K2").Value

    .HTMLBody = strBody & vbNewLine
    .HTMLBody = .HTMLBody & "<br>" & RangetoHTML(rng) & vbNewLine & vbNewLine

   .HTMLBody = .HTMLBody & "<br><a href=Z:\Activities\ABC.xlsm> PEC_FILE  </a> <br><br><br>  Best Regards,<br> ABC Team"

    .send
    End With
    'Next i

debugs:
    If Err.Description <> "" Then
        MsgBox Err.Description
    Else
        'MsgBox "Mail sent successfully,", vbOKOnly, "SOA"
    End If
    MsgBox "Done"


End Sub
...