Adding an Task Item to a public folder with VBA

Posted on 2009-12-30
Last Modified: 2013-12-20
 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

Question by:HelpMePlease777
    LVL 76

    Accepted Solution

    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


    Author Closing Comment

    LVL 76

    Expert Comment

    by:David Lee
    You're welcome.  Happy New Year!

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Enabling OSINT in Activity Based Intelligence

    Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

    My experience with Windows 10 over a one year period and suggestions for smooth operation
    Email signatures have numerous marketing benefits. Here are 8 top reasons to turn your email signature into a marketing channel.
    As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
    To add imagery to an HTML email signature, you have two options available to you. You can either add a logo/image by embedding it directly into the signature or hosting it externally and linking to it. The vast majority of email clients display l…

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    17 Experts available now in Live!

    Get 1:1 Help Now