Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > How do I get this to look at a date and loop down all the info?
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 95
Default How do I get this to look at a date and loop down all the info?
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
Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default How do I get this to look at a date and loop down all the info?
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" wrote in message
...
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


Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 95
Default How do I get this to look at a date and loop down all the info
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" wrote in message
...
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



Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default How do I get this to look at a date and loop down all the info
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 )



HTH,
Bernie
MS Excel MVP


"Pasty" wrote in message
...
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" wrote in message
...
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





Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default How do I get this to look at a date and loop down all the info
Sorry. With the address in quotes, since it needs to be a string...

.Recipients.Add ")


HTH,
Bernie
MS Excel MVP


Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 95
Default How do I get this to look at a date and loop down all the info
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 ")


HTH,
Bernie
MS Excel MVP



Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 5,441
Default How do I get this to look at a date and loop down all the info
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" wrote in message
...
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 ")


HTH,
Bernie
MS Excel MVP





Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
loop through code and refernce text file for info Sabosis Excel Discussion (Misc queries) 1 September 21st 11 01:40 AM
How do I use the IF function with info that contains a date? Red River Transport Excel Worksheet Functions 1 March 2nd 09 04:47 PM
Recovering File Info Specifically Save Date or Print Date Gadgetgw Excel Discussion (Misc queries) 4 October 6th 08 08:43 PM
Calendar and info for that date Jenn Excel Discussion (Misc queries) 0 January 5th 05 04:21 PM
Date selection loop Roger[_8_] Excel Programming 12 September 26th 04 12:53 AM


All times are GMT +1. The time now is 11:45 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement