I have some code that fires of actions to peoples tasks to remind them that
they have bits and bobs coming out - what I want it to do is go down the
spreadsheet (its around 296 rows and has merged cells for some bits) and see
if there is a month or less until the action is due and then send it but it
is giving me a headache.

The code that works for the initial task sending is as follows:

Sub Create_Task()

Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim Subject As String
Dim Body As String
Dim wbBook As Workbook
Dim wsMain As Worksheet

Set wbBook = ThisWorkbook
Set wsMain = wbBook.Worksheets("Risk By Function")

Set olApp = New Outlook.Application
Set olTask = olApp.CreateItem(3)

With wsMain
Subject = "Non-Financial Risk Actions due"
Body = "Action due:" & vbCrLf & .Cells(5, 21).Value
Body2 = "Due date:" & vbCrLf & .Cells(5, 22).Value
End With

Application.ScreenUpdating = False

'With olTask
'.Subject = "This is the title"
'.Body = "This is the body"
'You need to change to Your own dateformat.
'.StartDate = "2002-09-11"
'.DueDate = "2002-09-14"
'.Status = olTaskWaiting
'.Importance = olImportanceHigh
'.ReminderPlaySound = True
'.Companies = "XL-Dennis"
'.Save
'End With
On Error GoTo Error_Handling

With olTask
..Subject = Subject
..Body = Body
..StartDate = Date
..DueDate = "28/04/2007"
..Importance = olImportanceHigh
..Save
..Recipients.Add ("Ruth Brink")
..Assign
..Send
End With

Set olTask = Nothing

Set olApp = Nothing

Application.ScreenUpdating = True

MsgBox "The task-list updated successfully.", vbInformation

Error_Handling:
If Err.Number = 429 And olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: "
Resume
End If


End Sub

Any help with this would be greatly appreciated.

Regards

Pasty,

The general idea is to loop through your values checking for the condition. For the macro below,
I've assumed that the dates are in column V, and that column W is free to put in a flag so that you
won't duplicate tasks. Also, your recipient is poor Ruth every time, so you may want to change that
part.

HTH,
Bernie
MS Excel MVP


Sub Create_Tasks()

Dim olApp As Outlook.Application
Dim olTask As Outlook.TaskItem
Dim Subject As String
Dim Body As String
Dim wbBook As Workbook
Dim wsMain As Worksheet
Dim myCell As Range
Dim myR As Range


Set wbBook = ThisWorkbook
Set wsMain = wbBook.Worksheets("Risk By Function")
Set myR = wsMain.Range("V5:V500")

Set olApp = New Outlook.Application

For Each myCell In myR
If myCell.Value <> "" And _
myCell.Value <= Now + 30 And _
myCell(1, 2).Value <> "Notified" Then

Set olTask = olApp.CreateItem(3)

With wsMain
Subject = "Non-Financial Risk Actions due"
Body = "Action due:" & vbCrLf & .Cells(myCell.Row, 21).Value
Body2 = "Due date:" & vbCrLf & .Cells(myCell.Row, 22).Value
End With

Application.ScreenUpdating = False

On Error GoTo Error_Handling

With olTask
.Subject = Subject
.Body = Body
.StartDate = Date
.DueDate = wsMain.Cells(myCell.Row, 22).Text
.Importance = olImportanceHigh
.Save
.Recipients.Add ("Ruth Brink")
.Assign
.Send
End With

Set olTask = Nothing

Set olApp = Nothing

Application.ScreenUpdating = True

' MsgBox "The task-list updated successfully.", vbInformation

Error_Handling:
If Err.Number = 429 And olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: "
Resume
End If

myCell(1, 2).Value = "Notified"
End If
Next myCell

End Sub





"Pasty" <(E-Mail Removed)> wrote in message
news:93EC63F2-AE0D-417F-961E-(E-Mail Removed)...
>I have some code that fires of actions to peoples tasks to remind them that
> they have bits and bobs coming out - what I want it to do is go down the
> spreadsheet (its around 296 rows and has merged cells for some bits) and see
> if there is a month or less until the action is due and then send it but it
> is giving me a headache.
>
> The code that works for the initial task sending is as follows:
>
> Sub Create_Task()
>
> Dim olApp As Outlook.Application
> Dim olTask As Outlook.TaskItem
> Dim Subject As String
> Dim Body As String
> Dim wbBook As Workbook
> Dim wsMain As Worksheet
>
> Set wbBook = ThisWorkbook
> Set wsMain = wbBook.Worksheets("Risk By Function")
>
> Set olApp = New Outlook.Application
> Set olTask = olApp.CreateItem(3)
>
> With wsMain
> Subject = "Non-Financial Risk Actions due"
> Body = "Action due:" & vbCrLf & .Cells(5, 21).Value
> Body2 = "Due date:" & vbCrLf & .Cells(5, 22).Value
> End With
>
> Application.ScreenUpdating = False
>
> 'With olTask
> '.Subject = "This is the title"
> '.Body = "This is the body"
> 'You need to change to Your own dateformat.
> '.StartDate = "2002-09-11"
> '.DueDate = "2002-09-14"
> '.Status = olTaskWaiting
> '.Importance = olImportanceHigh
> '.ReminderPlaySound = True
> '.Companies = "XL-Dennis"
> '.Save
> 'End With
> On Error GoTo Error_Handling
>
> With olTask
> .Subject = Subject
> .Body = Body
> .StartDate = Date
> .DueDate = "28/04/2007"
> .Importance = olImportanceHigh
> .Save
> .Recipients.Add ("Ruth Brink")
> .Assign
> .Send
> End With
>
> Set olTask = Nothing
>
> Set olApp = Nothing
>
> Application.ScreenUpdating = True
>
> MsgBox "The task-list updated successfully.", vbInformation
>
> Error_Handling:
> If Err.Number = 429 And olApp Is Nothing Then
> Set olApp = CreateObject("Outlook.Application")
> Resume Next
> Else
> MsgBox "Error No: " & Err.Number & "; Description: "
> Resume
> End If
>
>
> End Sub
>
> Any help with this would be greatly appreciated.
>
> Regards

I tried this out and it gives me lots of different errors one after the other
e.g. Error No: -2114961403; Description: and when I press okay it brings up
another one with a different number so I have to exit the spreadsheet with
Task Manager.

"Bernie Deitrick" wrote:

> Pasty,
>
> The general idea is to loop through your values checking for the condition. For the macro below,
> I've assumed that the dates are in column V, and that column W is free to put in a flag so that you
> won't duplicate tasks. Also, your recipient is poor Ruth every time, so you may want to change that
> part.
>
> HTH,
> Bernie
> MS Excel MVP
>
>
> Sub Create_Tasks()
>
> Dim olApp As Outlook.Application
> Dim olTask As Outlook.TaskItem
> Dim Subject As String
> Dim Body As String
> Dim wbBook As Workbook
> Dim wsMain As Worksheet
> Dim myCell As Range
> Dim myR As Range
>
>
> Set wbBook = ThisWorkbook
> Set wsMain = wbBook.Worksheets("Risk By Function")
> Set myR = wsMain.Range("V5:V500")
>
> Set olApp = New Outlook.Application
>
> For Each myCell In myR
> If myCell.Value <> "" And _
> myCell.Value <= Now + 30 And _
> myCell(1, 2).Value <> "Notified" Then
>
> Set olTask = olApp.CreateItem(3)
>
> With wsMain
> Subject = "Non-Financial Risk Actions due"
> Body = "Action due:" & vbCrLf & .Cells(myCell.Row, 21).Value
> Body2 = "Due date:" & vbCrLf & .Cells(myCell.Row, 22).Value
> End With
>
> Application.ScreenUpdating = False
>
> On Error GoTo Error_Handling
>
> With olTask
> .Subject = Subject
> .Body = Body
> .StartDate = Date
> .DueDate = wsMain.Cells(myCell.Row, 22).Text
> .Importance = olImportanceHigh
> .Save
> .Recipients.Add ("Ruth Brink")
> .Assign
> .Send
> End With
>
> Set olTask = Nothing
>
> Set olApp = Nothing
>
> Application.ScreenUpdating = True
>
> ' MsgBox "The task-list updated successfully.", vbInformation
>
> Error_Handling:
> If Err.Number = 429 And olApp Is Nothing Then
> Set olApp = CreateObject("Outlook.Application")
> Resume Next
> Else
> MsgBox "Error No: " & Err.Number & "; Description: "
> Resume
> End If
>
> myCell(1, 2).Value = "Notified"
> End If
> Next myCell
>
> End Sub
>
>
>
>
>
> "Pasty" <(E-Mail Removed)> wrote in message
> news:93EC63F2-AE0D-417F-961E-(E-Mail Removed)...
> >I have some code that fires of actions to peoples tasks to remind them that
> > they have bits and bobs coming out - what I want it to do is go down the
> > spreadsheet (its around 296 rows and has merged cells for some bits) and see
> > if there is a month or less until the action is due and then send it but it
> > is giving me a headache.
> >
> > The code that works for the initial task sending is as follows:
> >
> > Sub Create_Task()
> >
> > Dim olApp As Outlook.Application
> > Dim olTask As Outlook.TaskItem
> > Dim Subject As String
> > Dim Body As String
> > Dim wbBook As Workbook
> > Dim wsMain As Worksheet
> >
> > Set wbBook = ThisWorkbook
> > Set wsMain = wbBook.Worksheets("Risk By Function")
> >
> > Set olApp = New Outlook.Application
> > Set olTask = olApp.CreateItem(3)
> >
> > With wsMain
> > Subject = "Non-Financial Risk Actions due"
> > Body = "Action due:" & vbCrLf & .Cells(5, 21).Value
> > Body2 = "Due date:" & vbCrLf & .Cells(5, 22).Value
> > End With
> >
> > Application.ScreenUpdating = False
> >
> > 'With olTask
> > '.Subject = "This is the title"
> > '.Body = "This is the body"
> > 'You need to change to Your own dateformat.
> > '.StartDate = "2002-09-11"
> > '.DueDate = "2002-09-14"
> > '.Status = olTaskWaiting
> > '.Importance = olImportanceHigh
> > '.ReminderPlaySound = True
> > '.Companies = "XL-Dennis"
> > '.Save
> > 'End With
> > On Error GoTo Error_Handling
> >
> > With olTask
> > .Subject = Subject
> > .Body = Body
> > .StartDate = Date
> > .DueDate = "28/04/2007"
> > .Importance = olImportanceHigh
> > .Save
> > .Recipients.Add ("Ruth Brink")
> > .Assign
> > .Send
> > End With
> >
> > Set olTask = Nothing
> >
> > Set olApp = Nothing
> >
> > Application.ScreenUpdating = True
> >
> > MsgBox "The task-list updated successfully.", vbInformation
> >
> > Error_Handling:
> > If Err.Number = 429 And olApp Is Nothing Then
> > Set olApp = CreateObject("Outlook.Application")
> > Resume Next
> > Else
> > MsgBox "Error No: " & Err.Number & "; Description: "
> > Resume
> > End If
> >
> >
> > End Sub
> >
> > Any help with this would be greatly appreciated.
> >
> > Regards
>
>
>

Pasty,

The looping code worked for me in my testing.

Unfortunately, I assumed that your statement "The code that works for the initial task sending is as
follows:" meant that the code you posted actually worked. But it is your initial code that is
throwing the error.

There are two problems: you don't have a way for the code to get around the error handler, and you
don't display the description of the error - use this in place of your Error_Handling:

GoTo NoErrors:
Error_Handling:
If Err.Number = 429 And olApp Is Nothing Then
Set olApp = CreateObject("Outlook.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description
Resume
End If

NoErrors:


Also, I used a working email address in the recipients.add line, and that worked for me

.Recipients.Add ((E-Mail Removed))



HTH,
Bernie
MS Excel MVP


"Pasty" <(E-Mail Removed)> wrote in message
news:BA5B9CD3-9D49-44A2-87B2-(E-Mail Removed)...
>I tried this out and it gives me lots of different errors one after the other
> e.g. Error No: -2114961403; Description: and when I press okay it brings up
> another one with a different number so I have to exit the spreadsheet with
> Task Manager.
>
> "Bernie Deitrick" wrote:
>
>> Pasty,
>>
>> The general idea is to loop through your values checking for the condition. For the macro below,
>> I've assumed that the dates are in column V, and that column W is free to put in a flag so that
>> you
>> won't duplicate tasks. Also, your recipient is poor Ruth every time, so you may want to change
>> that
>> part.
>>
>> HTH,
>> Bernie
>> MS Excel MVP
>>
>>
>> Sub Create_Tasks()
>>
>> Dim olApp As Outlook.Application
>> Dim olTask As Outlook.TaskItem
>> Dim Subject As String
>> Dim Body As String
>> Dim wbBook As Workbook
>> Dim wsMain As Worksheet
>> Dim myCell As Range
>> Dim myR As Range
>>
>>
>> Set wbBook = ThisWorkbook
>> Set wsMain = wbBook.Worksheets("Risk By Function")
>> Set myR = wsMain.Range("V5:V500")
>>
>> Set olApp = New Outlook.Application
>>
>> For Each myCell In myR
>> If myCell.Value <> "" And _
>> myCell.Value <= Now + 30 And _
>> myCell(1, 2).Value <> "Notified" Then
>>
>> Set olTask = olApp.CreateItem(3)
>>
>> With wsMain
>> Subject = "Non-Financial Risk Actions due"
>> Body = "Action due:" & vbCrLf & .Cells(myCell.Row, 21).Value
>> Body2 = "Due date:" & vbCrLf & .Cells(myCell.Row, 22).Value
>> End With
>>
>> Application.ScreenUpdating = False
>>
>> On Error GoTo Error_Handling
>>
>> With olTask
>> .Subject = Subject
>> .Body = Body
>> .StartDate = Date
>> .DueDate = wsMain.Cells(myCell.Row, 22).Text
>> .Importance = olImportanceHigh
>> .Save
>> .Recipients.Add ("Ruth Brink")
>> .Assign
>> .Send
>> End With
>>
>> Set olTask = Nothing
>>
>> Set olApp = Nothing
>>
>> Application.ScreenUpdating = True
>>
>> ' MsgBox "The task-list updated successfully.", vbInformation
>>
>> Error_Handling:
>> If Err.Number = 429 And olApp Is Nothing Then
>> Set olApp = CreateObject("Outlook.Application")
>> Resume Next
>> Else
>> MsgBox "Error No: " & Err.Number & "; Description: "
>> Resume
>> End If
>>
>> myCell(1, 2).Value = "Notified"
>> End If
>> Next myCell
>>
>> End Sub
>>
>>
>>
>>
>>
>> "Pasty" <(E-Mail Removed)> wrote in message
>> news:93EC63F2-AE0D-417F-961E-(E-Mail Removed)...
>> >I have some code that fires of actions to peoples tasks to remind them that
>> > they have bits and bobs coming out - what I want it to do is go down the
>> > spreadsheet (its around 296 rows and has merged cells for some bits) and see
>> > if there is a month or less until the action is due and then send it but it
>> > is giving me a headache.
>> >
>> > The code that works for the initial task sending is as follows:
>> >
>> > Sub Create_Task()
>> >
>> > Dim olApp As Outlook.Application
>> > Dim olTask As Outlook.TaskItem
>> > Dim Subject As String
>> > Dim Body As String
>> > Dim wbBook As Workbook
>> > Dim wsMain As Worksheet
>> >
>> > Set wbBook = ThisWorkbook
>> > Set wsMain = wbBook.Worksheets("Risk By Function")
>> >
>> > Set olApp = New Outlook.Application
>> > Set olTask = olApp.CreateItem(3)
>> >
>> > With wsMain
>> > Subject = "Non-Financial Risk Actions due"
>> > Body = "Action due:" & vbCrLf & .Cells(5, 21).Value
>> > Body2 = "Due date:" & vbCrLf & .Cells(5, 22).Value
>> > End With
>> >
>> > Application.ScreenUpdating = False
>> >
>> > 'With olTask
>> > '.Subject = "This is the title"
>> > '.Body = "This is the body"
>> > 'You need to change to Your own dateformat.
>> > '.StartDate = "2002-09-11"
>> > '.DueDate = "2002-09-14"
>> > '.Status = olTaskWaiting
>> > '.Importance = olImportanceHigh
>> > '.ReminderPlaySound = True
>> > '.Companies = "XL-Dennis"
>> > '.Save
>> > 'End With
>> > On Error GoTo Error_Handling
>> >
>> > With olTask
>> > .Subject = Subject
>> > .Body = Body
>> > .StartDate = Date
>> > .DueDate = "28/04/2007"
>> > .Importance = olImportanceHigh
>> > .Save
>> > .Recipients.Add ("Ruth Brink")
>> > .Assign
>> > .Send
>> > End With
>> >
>> > Set olTask = Nothing
>> >
>> > Set olApp = Nothing
>> >
>> > Application.ScreenUpdating = True
>> >
>> > MsgBox "The task-list updated successfully.", vbInformation
>> >
>> > Error_Handling:
>> > If Err.Number = 429 And olApp Is Nothing Then
>> > Set olApp = CreateObject("Outlook.Application")
>> > Resume Next
>> > Else
>> > MsgBox "Error No: " & Err.Number & "; Description: "
>> > Resume
>> > End If
>> >
>> >
>> > End Sub
>> >
>> > Any help with this would be greatly appreciated.
>> >
>> > Regards
>>
>>
>>

Sorry. With the address in quotes, since it needs to be a string...

.Recipients.Add ("(E-Mail Removed)")


HTH,
Bernie
MS Excel MVP

Hi there,

Its because the due date on some of the cells is less than the the date so
it is seeing it as an error. So I need to figure out how to get it to say if
the due date has passed then ignore and go through the rest and this is where
I am struggling.

Regards

Matt

"Bernie Deitrick" wrote:

> Sorry. With the address in quotes, since it needs to be a string...
>
> .Recipients.Add ("(E-Mail Removed)")
>
>
> HTH,
> Bernie
> MS Excel MVP
>
>
>

Pasty,

You can create as many conditions as you like:

If myCell.Value <> "" And _
myCell.Value <= Now + 30 And _
myCell.Value >= Now And _
myCell(1, 2).Value <> "Notified" Then

HTH,
Bernie
MS Excel MVP


"Pasty" <(E-Mail Removed)> wrote in message
newsF5666E2-4E4F-4C90-ACD0-(E-Mail Removed)...
> Hi there,
>
> Its because the due date on some of the cells is less than the the date so
> it is seeing it as an error. So I need to figure out how to get it to say if
> the due date has passed then ignore and go through the rest and this is where
> I am struggling.
>
> Regards
>
> Matt
>
> "Bernie Deitrick" wrote:
>
>> Sorry. With the address in quotes, since it needs to be a string...
>>
>> .Recipients.Add ("(E-Mail Removed)")
>>
>>
>> HTH,
>> Bernie
>> MS Excel MVP
>>
>>
>>