HELP macro to ensure certain person gets assigned task pane

[hetterbr]

Below is a macro that works quite well, but I need to make a bit of a change to it. This macro takes a line of information from Excel and creates a task in MicroSoft Outlook. It also ensures that the same task is only entered once.

I have not quite decided yet, but I want the tasks that this creates in outlook to either be assigned to a certain person assigned in the macro OR to have the ability to assign each task to someone differently via a column where each row is a separate item. The Excel spreadsheet will end up being saved on our network drive and not on a local drive so need to be able to tell the macro who to assign the task to.

thanks
Brent


Sub CreateTask()
Dim olApp As New Outlook.Application
Dim olName As Outlook.Namespace
Dim olFolder As Outlook.Folder
Dim olTasks As Outlook.Items
Dim olNewTask As Outlook.TaskItem
Dim strSubject As String
Dim strDate As String
Dim strBody As String
Dim reminderdate As String
Dim ws As Worksheet
Dim LR As Long
Dim i As Long
Set ws = Worksheets("sheet1") 'sheet where dates are
Set wg = Worksheets("sheet2") 'sheet where data is calculated
LR = ws.Range("D1").End(xlDown).Row 'get row for last cell in column D with value
Set olName = olApp.GetNamespace("MAPI")
Set olFolder = olName.GetDefaultFolder(olFolderTasks)
Set olTasks = olFolder.Items
For i = 2 To LR 'assuming the rows have headers, so loop starts on row 2
strSubject = ws.Range("D" & i) 'takes subject from column D
strDate = ws.Range("C" & i) 'takes date from column C
strBody = ws.Range("E" & i) 'takes text from column E and adds it as Body
reminderdate = wg.Range("D" & i) 'Takes date from column D and enters it as the reminder date
Set olNewTask = olTasks.Add(olTaskItem)
'delete task if it exists
'an error is generated if task doesn't exist
On Error Resume Next
olTasks.Item (strSubject)
If Err.Number = 0 Then
olTasks.Item(strSubject).Delete
End If
On Error GoTo 0
'create new task
With olNewTask
.Subject = strSubject
.Status = olTaskInProgress
.Importance = olImportanceNormal
.DueDate = DateValue(strDate)
.Body = strBody
.ReminderSet = True
.ReminderTime = reminderdate
.TotalWork = 40
.ActualWork = 20
.Save
End With
Next i
End Sub

 

[JP2112]

Please use [ code ] tags when posting VBA code.

You are currently adding these tasks to your own Tasks folder, correct? And you want to now start assigning them to others based on a value in the current row (different column), I assume the assignee's name or email address. Is that correct?

 

[hetterbr]

Yes, currently all tasks are being assigned to me. I wish to make a column where I can enter a name and have it create a task in Outlook for them in their own Outlook.

Email addresses are standardized - "firstname.lastname@gov.sk.ca"

 

[JP2112]

To assign a task you need to do a few things. In your For Loop:

1) Call the Assign method: olNewTask.Assign
2) Assign recipient(s):

strRecipient = ws.Range("G" & i)
olNewTask.Recipients.Add strRecipient

(assuming recipient info was in column G and variable name is strRecipient)

3) Call the Send method at the end of your With block: olNewTask.Send

 

[hetterbr]

thanks
Brent

 

[hetterbr]

Ok, so thought I knew what I was doing, but can't figure out where to put place the statements in my macro.

 

[JP2112]

I would put them inside your With block like this:

With olNewTask
' your other code here
.Assign
.Recipients.Add ws.Range("G" & i)
.Send
End With

 

[hetterbr]

Thanks, I will give it a try.

 

[hetterbr]

I have been trying to get this to work, but have not been able to.

It seems I don't follow directions very well and can't figure out what code goes where.

any chance of you taking the code I pasted earlier and specifically put the code into it and highlight it, so i can see it.

thanks

 

[hetterbr]

a bump for some assistance on this.

thanks