Z
ZR
I have a problem when running this code, if there is no value "over due" in
the sheet i keep on getting an error. I need it to work also when nothing is
found.
can anyone help?
Sub sendemail()
Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer
Dim myRecipient As String
Dim myFirstCellAdd
Dim myCounter As Integer
myCounter = 0
Range("AE1").Select
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Do Until ActiveCell.Address = myFirstCellAdd
myCounter = myCounter + 1
myCurrAdd = ActiveCell.Address
If myCounter = 1 Then myFirstCellAdd = ActiveCell.Address
myRow = ActiveCell.Row
ActiveSheet.Range("AE" & myRow).Select
Application.ScreenUpdating = False
For myLoop = 1 To 3000
If ActiveCell.Value = "" Then myBodyText = myBodyText & "" &
ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
If ActiveCell.Column = 1 Then myRecipient = ActiveCell.Value
If ActiveCell.Column = 3001 Then myBodyText = myBodyText Else
ActiveCell.Offset(0, 1).Select
Next
ActiveSheet.Range(myCurrAdd).Select
Set OutlookApp = CreateObject("Outlook.Application")
With OutlookApp.CreateItem(olMailItem)
.Subject = "Event Remainder"
.Body = Range("C" & myRow).Value & " " & Range("B" & myRow).Value &
" row " & Range("A" & myRow).Value
'e-mail adress as in the mail culumn
.To = Range("AF" & myRow).Value
.CC = Range("AG" & myRow).Value
.Send
'this will change the value of cell so no more mails will be sent for
this event
Range("AE" & myRow).Value = "Noted"
End With
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Loop
MsgBox (myCounter)
Application.ScreenUpdating = False
End Sub
the sheet i keep on getting an error. I need it to work also when nothing is
found.
can anyone help?
Sub sendemail()
Dim OutlookApp As Object
Dim myBodyText As String
Dim myLoop As Integer
Dim myRow As Integer
Dim myRecipient As String
Dim myFirstCellAdd
Dim myCounter As Integer
myCounter = 0
Range("AE1").Select
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Do Until ActiveCell.Address = myFirstCellAdd
myCounter = myCounter + 1
myCurrAdd = ActiveCell.Address
If myCounter = 1 Then myFirstCellAdd = ActiveCell.Address
myRow = ActiveCell.Row
ActiveSheet.Range("AE" & myRow).Select
Application.ScreenUpdating = False
For myLoop = 1 To 3000
If ActiveCell.Value = "" Then myBodyText = myBodyText & "" &
ActiveCell.Value Else myBodyText = myBodyText & " " & ActiveCell.Value
If ActiveCell.Column = 1 Then myRecipient = ActiveCell.Value
If ActiveCell.Column = 3001 Then myBodyText = myBodyText Else
ActiveCell.Offset(0, 1).Select
Next
ActiveSheet.Range(myCurrAdd).Select
Set OutlookApp = CreateObject("Outlook.Application")
With OutlookApp.CreateItem(olMailItem)
.Subject = "Event Remainder"
.Body = Range("C" & myRow).Value & " " & Range("B" & myRow).Value &
" row " & Range("A" & myRow).Value
'e-mail adress as in the mail culumn
.To = Range("AF" & myRow).Value
.CC = Range("AG" & myRow).Value
.Send
'this will change the value of cell so no more mails will be sent for
this event
Range("AE" & myRow).Value = "Noted"
End With
Cells.Find(What:="Over Due", After:=ActiveCell, LookIn:=xlValues, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False).Activate
Loop
MsgBox (myCounter)
Application.ScreenUpdating = False
End Sub