简体   繁体   中英

Sending Excel VBA email

I have some code in excel VBA. I need to send it by email. It looks fine but the email is not received. Can someone help me?

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

I had this problem too and I used this code below to send using 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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM