首页 > 解决方案 > 从 VBA 模块自动向人员发送电子邮件

问题描述

我想阅读分配给不同人的任务列表,并根据放置在电子表格范围内的电子邮件地址列表向他们发送有关分配给他们的任务的提醒,但是,忽略那些已经收到提醒的人。到目前为止我有这个代码。

Sub datesexcelvba()
    Dim myApp As Outlook.Application, myMail As Outlook.MailItem
    Dim duedate1 As Date
    Dim duedate2 As Long
    Dim todaydate1 As Date
    Dim todaydate2 As Long

    Dim x As Long
    'from what row the data needs to be read from
    lastrow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For x = 4 To lastrow


        'READS THE DUE DATE THEN TURNS INTO LONG
        duedate1 = Cells(x, 6).Value
        duedate2 = duedate1
        'PUTS DUE DATE LONG TEXT IN BELOW CELL
        Cells(x, 12).Value = duedate2

        'following just reads the due date, then turns it into a text format to read
        todaydate1 = Date
        todaydate2 = todaydate1
        'PUTS ABOVE DATE INTO CELL BELOW
        Cells(x, 13).Value = todaydate2

        Set myApp = New Outlook.Application
        Set myMail = myApp.CreateItem(olMailItem)

        'the following code is talking about finding the reminders if the deadline has been reached
        If duedate2 - todaydate2 = 2 Then
        'if email already sent, reads this box and should exclude these emails
            If Cells(x, 11).Value <> "Yes" Then
            'finding the email address to send to
                 myMail.To = Cells(x, 10).Value
            End If
        End If

        With myMail
            .Subject = "Safety Action Reminder"
            .Body = Cells(x, 7).Value
            'following line to see if email looks good
            .Display
            '.send
        End With

        'IF REMINDER NEEDS TO BE SENT, IT WILL AUTO FILL THE CELL WITH CODE BELOW
        'Cells(x, 7) = "Yes"
        'BELOW CODE JUST CHECKING THAT THE DEADLINE AND REMINDER ARE 2 DAYS APART
        Cells(x, 8).Value = duedate2 - todaydate2

    Next
    Set myApp = Nothing
    Set myMail = Nothing

End Sub

非常感谢

标签: excelvba

解决方案


尝试这个:

   ...

   Set myApp = New Outlook.Application
      Set myMail = myApp.CreateItem(olMailItem)

  'finding the email address to send to
  'HERE IS THE MODIFICATION I ADDED
  If Cells(x, 11).Value <> "Yes" Then
   myMail.To = Cells(x, 10).Value

  With myMail
    .Subject = "Safety Action Reminder"
    .Body = Cells(x, 11).Value
    'following line to see if email looks good
    .Display`enter code here`
    '.send
  End With

    ...

推荐阅读