Help with EMAIL macro

[antonschoene]

Hello everyone, I am new to the forum and am really stuck with this macro. I have searched and found multiple macros regarding emails and have had them work with one exception. The range that i am pulling the emails from has blanks. The list starts in cell BD9 and goes until BD45. The macro below works great if there is no blanks, but do to people coming and going from my list i will always have blanks. The macro gets hung up with the following [If cell.Value Like "?*@?*.?*" Then] line. Is there anything i can add the the code to ignore the blanks and go on to the next cell???

Dim cell As Range
Dim strto As String
For Each cell In ThisWorkbook.Sheets("Contacts").Range("BD9:BD45")
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
Next cell
If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
On Error GoTo cleanup
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = strto
.Subject = Worksheets("Contacts").Range("ac18")
.Body = ""
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

 

[daverunt]

Hi,

I don't see an error when using the 'like' part of the code even when the cell is blank.
However you would possibly have problems in the address list with empty cells.

For Each cell In ThisWorkbook.Sheets("Contacts").Range("BD9:BD45")
 If cell.Value Like "?*@?*.?*" Then
 If cell.Value <> "" Then

 strto = strto & cell.Value & ";"
 End If
 End If
 Next cell

 

[MUSGJS]

You could of course clean out the blanks from the mailing list before running the e-mail macro.

 

[antonschoene]

Dave thank you so much!!! That worked like a champ and now i can actually get some work done. Once again thanks