mailing from excel - For each cell - already in use - error

[Eddy Stan]

hi
i am trying to send mail from excel file
Name mail id check body
John 1 (e-mail address removed) yes this is to remind you...1
john 2 (e-mail address removed) yes this is to remind you...2
i have edited the code from http://www.rondebruin.nl/mail/tips2.htm
i get For each cell ... next error for the strbody loop, giving the code below

------------------------------------

Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strto As String
Dim strbody As String

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

On Error GoTo cleanup
' For Each cell In
Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) =
"yes" Then

' TO CHOOSE DIFFERENT TO-MAIL ID
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Range("B3:B5").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If

' this loop is giving error as the For Each cell is already in use
'*********************************************
' TO CHOOSE MATTER TO PRINT IN MAIL BODY
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("D35")
strbody = strbody & cell.Value & vbNewLine
Next

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = strto
.Subject = "Reminder"
.body = strbody

' .bODY = "Dear " & cell.Offset(0, -1).Value & vbNewLine &
vbNewLine & _
' "Please contact us to discuss bringing your account
up to date"
' You can add files also like this
' .Attachments.Add ("C:\test.txt")

.Send 'Or use Display

End With

On Error GoTo 0

If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

Set OutMail = Nothing
' End If
Next cell
End If



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

 

[Leith Ross]

hi
i am trying to send mail from excel file
Name mail id check body
John 1 (e-mail address removed) yes this is to remind you...1
john 2 (e-mail address removed) yes this is to remind you...2
i have edited the code fromhttp://www.rondebruin.nl/mail/tips2.htm
i get For each cell ... next error for the strbody loop, giving the code below

------------------------------------

Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strto As String
Dim strbody As String

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

On Error GoTo cleanup
' For Each cell In
Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) =
"yes" Then

' TO CHOOSE DIFFERENT TO-MAIL ID
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Range("B3:B5").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If

' this loop is giving error as the For Each cell is already in use
'*********************************************
' TO CHOOSE MATTER TO PRINT IN MAIL BODY
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("D35")
strbody = strbody & cell.Value & vbNewLine
Next

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = strto
.Subject = "Reminder"
.body = strbody

' .bODY = "Dear " & cell.Offset(0, -1).Value & vbNewLine &
vbNewLine & _
' "Please contact us to discuss bringing your account
up to date"
' You can add files also like this
' .Attachments.Add ("C:\test.txt")

.Send 'Or use Display

End With

On Error GoTo 0

If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

Set OutMail = Nothing
' End If
Next cell
End If

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

------------------------------------------------

can u please help to get out of this loop

advance thanks

Hello Eddy Stan,

The For Each Loop above the one generating the error has the same
control value name CELL. Change the name of the Control value in the
loop causing the error. For example...
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' TO CHOOSE MATTER TO PRINT IN MAIL BODY
For Each C In
ThisWorkbook.Sheets("Sheet1").Range("D35")
strbody = strbody & cell.Value & vbNewLine
Next C

 

[Eddy Stan]

Hello Eddy Stan,

The For Each Loop above the one generating the error has the same
control value name CELL. Change the name of the Control value in the
loop causing the error. For example...
------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
' TO CHOOSE MATTER TO PRINT IN MAIL BODY
For Each C In
ThisWorkbook.Sheets("Sheet1").Range("D35")
strbody = strbody & cell.Value & vbNewLine
Next C

Sub TestFile()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strto As String
Dim strbody As String

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

On Error GoTo cleanup
' For Each cell In
Sheets("Sheet1").Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) =
"yes" Then

' TO CHOOSE DIFFERENT TO-MAIL ID
For Each cell In ThisWorkbook.Sheets("Sheet1") _
.Range("B3:B5").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" Then
strto = strto & cell.Value & ";"
End If
' TO CHOOSE MATTER TO PRINT IN MAIL BODY
For Each C In ThisWorkbook.Sheets("Sheet1").Range("D35")
strbody = strbody & cell.Value & vbNewLine
Next C

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = strto
.Subject = "Reminder"
.body = "Dear " & cell.Offset(0, -1).Value & vbNewLine &
vbNewLine & _
"Please contact us to discuss bringing your account
up to date"
' You can add files also like this
' .Attachments.Add ("C:\test.txt")

.Send 'Or use Display

End With

On Error GoTo 0

If Len(strto) > 0 Then strto = Left(strto, Len(strto) - 1)

Set OutMail = Nothing
' End If

Next cell
End If



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


I have changed as you have advised and the error is not coming but at the
same time the mail is being processed.

please into the above code.

 

[Eddy Stan]

Hi

I have changed as you have advised. The error is not coming up but at the
same time the mail is NOT being processed.