Here is the code I found and slightly altered. It gets a run-time error on the bolded line below. It worked prior to me trying to convert but now I need to make it compatible with other versions of Outlook. Please advise.
Sub CreateTask()
Dim OLApp As Object
Dim olName As Object
Dim olFolder As Object
Dim olTasks As Object
Dim olNewTask As Object
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("Entry Form") 'sheet where dates are
LR = ws.Range("E4").End(xlDown).Row 'get row for last cell in column D with value
Set OLApp = CreateObject("Outlook.Application")
Set olName = OLApp.GetNamespace("MAPI")
Set olFolder = olName.GetDefaultFolder(olFolderTasks)
Set olTasks = olFolder.Items
For i = 5 To LR 'assuming the rows have headers, so loop starts on row 2
strSubject = ws.Range("E" & i) 'takes subject from column D
strDate = ws.Range("B" & i) 'takes date from column C
strBody = ws.Range("D" & i) 'takes text from column E and adds it as Body
reminderdate = ws.Range("A" & 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
If Range("M" & i) = Environ("Username") Then
With olNewTask
.Subject = strSubject
.Status = olTaskInProgress
.Importance = olImportanceNormal
.StartDate = DateValue(strDate)
.DueDate = ws.Range("A" & i)
.Body = strBody
.ReminderSet = True
.ReminderTime = reminderdate
.Save
End With
End If
Next i
End Sub
Sub CreateTask()
Dim OLApp As Object
Dim olName As Object
Dim olFolder As Object
Dim olTasks As Object
Dim olNewTask As Object
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("Entry Form") 'sheet where dates are
LR = ws.Range("E4").End(xlDown).Row 'get row for last cell in column D with value
Set OLApp = CreateObject("Outlook.Application")
Set olName = OLApp.GetNamespace("MAPI")
Set olFolder = olName.GetDefaultFolder(olFolderTasks)
Set olTasks = olFolder.Items
For i = 5 To LR 'assuming the rows have headers, so loop starts on row 2
strSubject = ws.Range("E" & i) 'takes subject from column D
strDate = ws.Range("B" & i) 'takes date from column C
strBody = ws.Range("D" & i) 'takes text from column E and adds it as Body
reminderdate = ws.Range("A" & 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
If Range("M" & i) = Environ("Username") Then
With olNewTask
.Subject = strSubject
.Status = olTaskInProgress
.Importance = olImportanceNormal
.StartDate = DateValue(strDate)
.DueDate = ws.Range("A" & i)
.Body = strBody
.ReminderSet = True
.ReminderTime = reminderdate
.Save
End With
End If
Next i
End Sub