Question

我有一个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

通过一天中的日期和时间向用户发送提醒电子邮件-自动

0 个答案: