Adding an Task Item to a public folder with VBA

 I have a section of code that will add a task to a give users task list in outlook..... but I can not figure out how to add the same task to a task list in a public folder.  I need the task to be added to:  "Public Folders\All Public Folders\ProjectTest".   Any help would be greatly appreciated.  Thanks.
Dim objoutlook As Object
    Dim oNameSpace As Object
    Dim oSpDesk As Object
    Dim oFolder As Object
    Dim objtask As Object
     Set objoutlook = CreateObject("Outlook.Application")

    Set oNameSpace = objoutlook.GetNamespace("MAPI")
    Set oSpDesk = oNameSpace.CreateRecipient("Blow, Joe")
    Set oFolder = oNameSpace.GetSharedDefaultFolder(oSpDesk, 13)   '13 = olFolderTasks
    Set objtask = oFolder.Items.Add
        objtask.Subject = "Flow Test"
        objtask.DueDate = CDate("12/30/2009")
        objtask.ReminderSet = True

Open in new window

Who is Participating?
David LeeCommented:
Hi, HelpMePlease777.

To add a task to a public folder you simply need to get the public folder object and then add the task to it as you do on line 12.  The code below will return a folder based on an Outlook folder path.  For example

    Set objFolder = OpenOutlookFolder("Public Folders\Projects\Project 1")
    Set objtask = objFolder.Items.Add
Function OpenOutlookFolder(strFolderPath As String) As Outlook.MAPIFolder
    ' Purpose: Opens an Outlook folder from a folder path.'
    ' Written: 4/24/2009'
    ' Author:  BlueDevilFan'
    ' Outlook: All versions'
    Dim arrFolders As Variant, _
        varFolder As Variant, _
        bolBeyondRoot As Boolean
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            Select Case bolBeyondRoot
                Case False
                    Set OpenOutlookFolder = Outlook.Session.Folders(varFolder)
                    bolBeyondRoot = True
                Case True
                    Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
            End Select
            If Err.Number <> 0 Then
                Set OpenOutlookFolder = Nothing
                Exit For
            End If
    End If
    On Error GoTo 0
End Function

Open in new window

HelpMePlease777Author Commented:
David LeeCommented:
You're welcome.  Happy New Year!
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.