CODEWITHSUNDEEP
excelvba
mabanger
mabanger

Reputation: 147

Why is this vb script not sending the email?

I have the following script in excel, it should send an email (recipient should be in B24), but I'm getting no error message, but the emails are not delivered either. Any help would be really appreciated.

Could somebody explain to me what's wrong or what did I do wrong here?

Sub Email2()
    Dim sh As Worksheet
    Dim wb As Workbook
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object

    TempFilePath = Environ$("temp") & "\"

    If Val(Application.Version) < 12 Then
        FileExtStr = ".xls": FileFormatNum = -4143
    Else
        FileExtStr = ".xlsm": FileFormatNum = 52
    End If

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set OutApp = CreateObject("Outlook.Application")

    For Each sh In ThisWorkbook.Worksheets
        If sh.Range("B28").Value Like "?*@?*.?*" Then

            sh.Copy
            Set wb = ActiveWorkbook

            TempFileName = "Performance " & sh.Name & " date " & Format(Now, "dd-mmm-yy h-mm-ss")

            Set OutMail = OutApp.CreateItem(0)

            With wb
                .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

                On Error Resume Next
                With OutMail
                    .TO = sh.Range("B24").Value
                    .CC = ""
                    .BCC = ""
                    .Subject = "This is the subject"
                    .Body = "Hello,"
                    .Attachments.Add wb.FullName
                    .Send
                End With
                On Error GoTo 0

                .Close savechanges:=False
            End With

            Set OutMail = Nothing

            Kill TempFilePath & TempFileName & FileExtStr

        End If
    Next sh

    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Upvotes: 0

Views: 64

Answers (1)

Mathieu Desjardin
Mathieu Desjardin

Reputation: 64

The code you provided worked for me on Excel 2010.

All I can see is that you check if the value in "B28" looks like an email address, and then send the email to the address in "B24". Is it the problem ?

For my test, I put my address in both "B28" and "B24".

Upvotes: 1

Related Questions