在VBA 2013中自动发送电子邮件

时间:2016-03-25 10:54:10

标签: excel vba excel-vba

我是宏观新手。  我需要excel在截止日期即将到来时自动发送电子邮件。 (约15天前的例子)。到目前为止,我已经将电子邮件发送给所有人,而不考虑日期或条件格式。

Dim myApp As Outlook.Application, mymail As Outlook.MailItem
        Dim mydate1 As Date
        Dim mydate2 As Long
        Dim datetoday1 As Date
        Dim datetoday2 As Long

Dim x As Long
With Sheet1

         Lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
         For x = 2 To Lastrow

        mydate1 = Cells(x, 6).Value
        mydate2 = mydate1

Cells(x, 10).Value = mydate2

        datetoday1 = Date
        datetoday2 = datetoday1

Cells(x, 9).Value = datetoday2

        If mydate2 - datetoday2 >= 15 Then

End If

    'Cells(x, 8).Font.Bold = “Send”
    Cells(x, 8).Interior.ColorIndex = 3
    Cells(x, 8).Font.ColorIndex = 1
    Cells(x, 8).Font.Bold = True
    Cells(x, 8).Value = datetoday2 - mydate2

        Dim olApp As Outlook.Application
        Dim olEmail As Outlook.MailItem

        Set olApp = New Outlook.Application
        Set olEmail = olApp.CreateItem(olMailItem)
        olEmail.To = Cells(, 5).Value

With olEmail

        .BodyFormat = olFormatHTML
        '.Display
        .HTMLBody = "<h1>Hej </h1><br> Detta är ett mail som du ska läsa" & "<br>" & .HTMLBody
        .Subject = "Möte"
        .BCC = Cells(x, 5).Value

        '.send
End With

 Next
        Set myApp = Nothing
        Set mymail = Nothing
End With

End Sub

1 个答案:

答案 0 :(得分:0)

您有一行您可以测试两个日期之间的差异:

If mydate2 - datetoday2 >= 15 Then

我将假设如果该日期成功,那么您想发送电子邮件。 (我希望我对这个假设是错误的。对特定天数的测试需要比这更好。更多以下。)所以你希望你的电子邮件发送代码在if..then行之后和之前结束如果。但是,您立即按照if ...然后使用End If。

如果降低,你需要结束:

If mydate2 - datetoday2 >= 15 Then

    'Cells(x, 8).Font.Bold = “Send”
    Cells(x, 8).Interior.ColorIndex = 3

    ' Code missed out here for clarity & brevity.

    With olEmail
        .BodyFormat = olFormatHTML
        '.Display
        .HTMLBody = "<h1>Hej </h1><br> Detta är ett mail som du ska läsa" & "<br>" & .HTMLBody
        .Subject = "Möte"
        .BCC = Cells(x, 5).Value

        '.send
    End With

End If ' Here is the end if from above
Next

回到你需要做的实际测试,你应该使用DateDiff函数:

Dim d1 As Date
Dim d2 As Date
Dim days As Long

d1 = CDate("1 Jan 2016")
d2 = CDate("16 Jan 2016")

days = DateDiff("d", d2, d1) ' days is -15
days = DateDiff("d", d1, d2) ' days is +15

If days = 15 Then

    ' send email code

End If

干杯 -