S
smackellarjr
I have written this bit of code that goes through a worksheet, and
sends line items to Outlook recipients as tasks. I now it's probably
not the best piece of code, but it works. Now I need to be able to
send the same task to multiple users, their user ID's would be in the
same cell, and separated by a comma or something. I'm not exactly sure
how to make this happen. Here is my code, if anyone has any
suggestions, they would be appreciated. Here is the code:
Dim olApp As Outlook.Application
Dim olTsk As TaskItem
Dim olDelegate As Outlook.Recipient
Dim cell As Range
'start for loop to begin sending tasks
For Each cell In Range("B8", Range("B8").End(xlDown)).Cells
Set olApp = New Outlook.Application
Set olTsk = olApp.CreateItem(olTaskItem)
'if task has been sent skip
If cell.Offset(0, 8).Value = "X" Then GoTo exitearly
If cell.Offset(0, 8).Value = "x" Then GoTo exitearly
'set recipient of task
Set olDelegate = olTsk.Recipients.Add(cell.Offset(0, 7).Value)
olDelegate.Resolve
'if recipient is valid create task
If olDelegate.Resolved Then
With olTsk
.Subject = cell.Offset(0, 0).Value
.Body = cell.Offset(0, 1).Value
.Status = olTaskNotStarted
.Importance = olImportanceHigh
.StartDate = cell.Offset(0, 3).Value
.DueDate = cell.Offset(0, 4).Value
.TotalWork = 40
.ActualWork = 20
.Assign
.Send
End With
Else
'if recipient is not valid display error
MsgBox (cell.Offset(0, 7).Value & " is not a valid user on
this system.")
GoTo exitearly
End If
'mark task sent when sent
cell.Offset(0, 8).Value = "X"
exitearly: 'goto point to escape loop
Set olTsk = Nothing
Set olApp = Nothing
Next cell
Set olTsk = Nothing
Set olApp = Nothing
sends line items to Outlook recipients as tasks. I now it's probably
not the best piece of code, but it works. Now I need to be able to
send the same task to multiple users, their user ID's would be in the
same cell, and separated by a comma or something. I'm not exactly sure
how to make this happen. Here is my code, if anyone has any
suggestions, they would be appreciated. Here is the code:
Dim olApp As Outlook.Application
Dim olTsk As TaskItem
Dim olDelegate As Outlook.Recipient
Dim cell As Range
'start for loop to begin sending tasks
For Each cell In Range("B8", Range("B8").End(xlDown)).Cells
Set olApp = New Outlook.Application
Set olTsk = olApp.CreateItem(olTaskItem)
'if task has been sent skip
If cell.Offset(0, 8).Value = "X" Then GoTo exitearly
If cell.Offset(0, 8).Value = "x" Then GoTo exitearly
'set recipient of task
Set olDelegate = olTsk.Recipients.Add(cell.Offset(0, 7).Value)
olDelegate.Resolve
'if recipient is valid create task
If olDelegate.Resolved Then
With olTsk
.Subject = cell.Offset(0, 0).Value
.Body = cell.Offset(0, 1).Value
.Status = olTaskNotStarted
.Importance = olImportanceHigh
.StartDate = cell.Offset(0, 3).Value
.DueDate = cell.Offset(0, 4).Value
.TotalWork = 40
.ActualWork = 20
.Assign
.Send
End With
Else
'if recipient is not valid display error
MsgBox (cell.Offset(0, 7).Value & " is not a valid user on
this system.")
GoTo exitearly
End If
'mark task sent when sent
cell.Offset(0, 8).Value = "X"
exitearly: 'goto point to escape loop
Set olTsk = Nothing
Set olApp = Nothing
Next cell
Set olTsk = Nothing
Set olApp = Nothing