0 votes
in VBA by Beginner (5 points)
Hi !

I have an issue with a macro in Excel. I intend to send email under certain conditions; It worked perfect during a while but now It does not recognize the email address in the cell where it comes as the result of a formula (index & match), However when I enter an email address in the cell as value, it works just fine.

What could be the trick to resolve this?

Thx for your help.
by Beginner (40 points)
Are your calculations turned off at the point when vba tries to get the email address?

Could you index-match with vba, instead of the formula in the cell, to pull the right email?
by Beginner (5 points)

Hi rsremole

The calculations are turned on. So I believe...

It might help if I send the codes. i don't understand why it used to worked ok and suddenly it does not recognize the email format that comes in the cell In column E.

Additionally I add the formula that search for the email: =IFERROR(INDEX(Table1[E-Mail];MATCH($B5;Table1[ID];0);0);"").

Thx again for your help!

Sub Send_Email_Using_VBA()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "G").Value) = "yes" _
           And LCase(Cells(cell.Row, "H").Value) <> "send" Then

            Set OutMail = OutApp.CreateItem(0)
            
strbody = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."

            On Error Resume Next
With OutMail
        .Display
        .To = cell.Value
        .Subject = "Lorem Ipsum"
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Send
    End With

            On Error GoTo 0
            Cells(cell.Row, "H").Value = "send"
            Set OutMail = Nothing
End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

by Beginner (40 points)

I've never used your particular method before, but try replacing 'xlCellTypeConstants' with 'xlCellTypeFormulas'.

https://docs.microsoft.com/en-us/office/vba/api/excel.range.specialcells

Tried the loop. Constants pulled the header only. Formulas pulled the formula values also.

by Beginner (26 points)

.SpecialCells(xlCellTypeConstants) in your For loop did not allow values to be returned by formula, so I took that out. I figured that out by just isolating that part and doing a Debug.print Cell

I changed your For loop and added an if statement. The below code is tested and works.

 

Option Explicit

Sub Send_Email_Using_VBA()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

For Each cell In Columns("E").Cells
    If cell.Value Like "?*@?*.?*" Then
                If LCase(Cells(cell.Row, "G").Value) = "yes" _
                And LCase(Cells(cell.Row, "H").Value) <> "send" Then
                        Set OutMail = OutApp.CreateItem(0)
                End If
            
strbody = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."

            On Error Resume Next
With OutMail
        .Display
        .To = cell.Value
        .Subject = "Lorem Ipsum"
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Send
    End With

            On Error GoTo 0
            Cells(cell.Row, "H").Value = "send"
            Set OutMail = Nothing
    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

3 Answers

+1 vote
by Beginner (26 points)
selected by
 
Best answer

.SpecialCells(xlCellTypeConstants) in your For loop did not allow values to be returned by formula, so I took that out. I figured that out by just isolating that part and doing a Debug.print Cell

I changed your For loop and added an if statement. The below code is tested and works.

 

Option Explicit

Sub Send_Email_Using_VBA()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

For Each cell In Columns("E").Cells
    If cell.Value Like "?*@?*.?*" Then
                If LCase(Cells(cell.Row, "G").Value) = "yes" _
                And LCase(Cells(cell.Row, "H").Value) <> "send" Then
                        Set OutMail = OutApp.CreateItem(0)
                End If
            
strbody = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."

            On Error Resume Next
With OutMail
        .Display
        .To = cell.Value
        .Subject = "Lorem Ipsum"
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Send
    End With

            On Error GoTo 0
            Cells(cell.Row, "H").Value = "send"
            Set OutMail = Nothing
    End If
Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

by Beginner (5 points)

It works just perfect now! A big thanks to you.yes

0 votes
by Beginner (4 points)
Sub StartEmail()
Dim Addr As String
Dim Result As Long
Addr = “mailto:nobody@example.com”
Result = ShellExecute(0&, vbNullString, Addr, _
vbNullString, vbNullString, vbNormalFocus)
If Result < 32 Then MsgBox “Error”
End Sub

The above scipt comes from Excel 2013Power Programming and you colud call this sub in your coding and of course, you need to substitute the email address in the code.

CA Vikram S. Mathur

by Beginner (5 points)

Hello Vikram

Not sure how to insert the script your sent. I add the codes I use to get the email sent in outlook. You might find why it as working ok before and suddenly stop recognizing the email format in column E. Thx again for your help.

Sub Send_Email_Using_VBA()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

For Each cell In Columns("E").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "G").Value) = "yes" _
           And LCase(Cells(cell.Row, "H").Value) <> "send" Then

            Set OutMail = OutApp.CreateItem(0)
            
strbody = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua."

            On Error Resume Next
With OutMail
        .Display
        .To = cell.Value
        .Subject = "Lorem Ipsum"
        .HTMLBody = strbody & "<br>" & .HTMLBody
        .Send
    End With

            On Error GoTo 0
            Cells(cell.Row, "H").Value = "send"
            Set OutMail = Nothing
End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

0 votes
by Beginner (40 points)

Replace 'xlCellTypeConstants' with 'xlCellTypeFormulas'.

That is why it worked before and stopped working. You changed the constant to a formula.

Welcome to wellsr Q&A
wellsr Q&A is the VBA and Python programming community that rewards you for learning how to code.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Earn free prizes for asking VBA and Python questions and for answering questions asked by others in our community.

What makes us different?
Our points system rewards you with a chance for free gifts based on the quality of your questions and answers. All you have to do is post and you could get rewarded, like these members:

runfunke $10 Amazon Gift Card
coolag $10 Amazon Gift Card
Siew Hun $10 Amazon Gift Card

So, why don't you join us? It really is an encouraging way to motivate members in our VBA and Python community.

Register

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...