[AccessD] OT: Help with using Redemption to assing an Outlook task.

Try the code below...

Doris Manning
Database Administrator
Hargrove Inc.
www.hargroveinc.com

************************************

Public Function SendTask()
    
    Dim objOutlook As Outlook.Application
    Dim objOutlookTsk As Outlook.TaskItem
    Dim objSave as Object
    
    Dim strRecipList() As String
    Dim strNum As String
    Dim DDueDate As Date
    Dim strNote As String
    Dim strBody As String
    Dim i As Integer
        
    strRecipList() = Split(Forms!PrevActions!tbToWhom, ";")
    strNum = Forms![DMR Form]![tbDMRNum]
    DDueDate = Forms!PrevActions!tbDueDate
    strNote = Forms![DMR Form]!tbPartNo
    strBody = "Part Number: " & strNote & vbCrLf & vbCrLf & _
    "Discrepency: " & Nz(Forms![DMR Form]![Discrepencies
subform]!Discrepency, "None Entered") & vbCrLf & vbCrLf & _
    "Remedial Action: " & Nz(Forms![DMR Form]![Discrepencies
subform]![Corrective action], "None Entered") & vbCrLf & vbCrLf & _
    "Corrective Action: " & Nz(Forms![DMR Form]![Discrepencies
subform]!tbPrevActsub, "None Entered") & vbCrLf & vbCrLf
    
    
    ' Create the Outlook session.
    Set objOutlook = CreateObject("Outlook.Application")

    ' Create the message.
    Set objOutlookTsk = objOutlook.CreateItem(olTaskItem)

    ' Create the Redemption object
    Set objSafe = CreateObject("Redemption.SafeTaskItem")
    objSafe.Item = objOutlookTsk

    With objSafe
        ' Add the To recipient(s) to the message.
        For i = 0 To UBound(strRecipList)
            .Recipients.Add(strRecipList(i)).Type = olTo
        Next
                
        ' Set the Subject, Body, and Importance of the message.
        .Subject = "Corrective Action for DMR#" & strNum & " - (" & strNote
& ")"
        .Body = strBody
        .Importance = olImportanceHigh  'High importance
        .ReminderSet = True
        .ReminderTime = DDueDate - 7
        .DueDate = DDueDate
      

        ' Resolve each Recipient's name.
        For Each objOutlookRecip In .Recipients
            objOutlookRecip.Resolve
            If Not objOutlookRecip.Resolve Then
                objOutlookTsk.Display
            End If
        Next
        
        .Save
        .Assign
        .Send
        
    End With
   Set objSafe = nothing
   Set objOutlookTsk = Nothing
   Set objOutlook = Nothing
   
   MsgBox "Task has been assigned.", , "Task sent"

End Function