发送Excel VBA电子邮件

时间:2017-03-09 14:59:21

标签: excel vba excel-vba

我在excel VBA中有一些代码。我需要通过电子邮件发送。它看起来很好,但没有收到电子邮件。有人能帮助我吗?

i = 4
Do While Sheets("Data").Cells(i, 1).Value <> ""
    If Sheets("Data").Cells(i, 11).Value = "Pabaigtas" And Sheets("Data").Cells(i, 12).Value = "NE" And Sheets("Data").Cells(i, 10).Value <> "DONE" Then
        Sheets("Email").Range("A2:P2").ClearContents
        Sheets("Data").Range(Cells(i, 1), Cells(i, 16)).Copy
        Sheets("Email").Range("A2:P2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Sheets("Data").Cells(i, 10).Value = "DONE"
        Sheets("Email").Activate
        ActiveSheet.Range("A1:P2").Select
        ActiveWorkbook.EnvelopeVisible = True
        With ActiveSheet.MailEnvelope
           .Introduction = "NEATITIKIMU REGISTRAS"
           .Item.To = "justas.sirvinskas@havi.com" & ";" & "artur.poplavski@havi.com" & ";" & "vladimir.volchonskij@havi.com" & ";" & "anzelika.tamkun@havi.com" & ";" & "inga.maleckiene@havi.com" & ";" & "jurate.balzere@havi.com" & ";" & "andrius.kubilius@havi.com" & ";" & "rolandas.smaliukas@havi.com" & ";" & "jolanta.biciukiene@havi.com" & ";" & "edvinas.gerika@havi.com"
           .Item.Subject = "PABAIGTA UZDUOTIS NEATITIKIMU REGISTRE"
           .Item.Send
        End With
        ActiveWorkbook.EnvelopeVisible = False
    End If
    i = i + 1
Loop

1 个答案:

答案 0 :(得分:0)

我也有这个问题,我使用下面的代码发送使用outlook:

Public Sub testOutlook()
    Dim OutApp  As Object: Set OutApp = CreateObject("Outlook.Application")
    Dim OutMail As Object: Set OutMail = OutApp.CreateItem(0)

    OutMail.Display
    Signature = OutMail.HTMLBody
    strbody = "Some text here"

    With OutMail
        .SentOnBehalfOfName = ""
        .To = ""
        .CC = ""
        .BCC = ""
        .Subject = "TEST"
        .HTMLBody = strbody & Signature
        .Display
    End With
End Sub