How to create New Task in a Public Folder using VBA

[Storyteller]

Hello All,
I am using this code to create a new task that appears in the users task folder. However, I would like it to be created in a Public Folder "Common Tasks". Any suggestions?

Public Sub CreateTask()
Dim outObj As Outlook.Application
Dim outTask As Outlook.TaskItem
Dim objFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace

Set outObj = CreateObject("outlook.application")
Set objNS = outObj.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item("Public Folders"). _
Folders.Item("All Public Folders"). _
Folders.Item("Common Tasks")
Set outTask = outObj.CreateItem(olTaskItem)

With outTask
.Subject = "Remember to call " & Forms!frmEmailSendingTest.FirstName _
& " " & Forms!frmEmailSendingTest.LastName
.DueDate = Date + 1
.ReminderSet = True
.Body = "Phone number is: " & Forms!frmEmailSendingTest.Phone
.Owner = GetMailboxUserName
.Display
End With



Set outObj = Nothing
Set outTask = Nothing

End Sub

Thanks for all your help.

Regards,
Michael

 

[Storyteller]

Hello All,
I have not been able to find/figure out the code to create a task directly into a Exchange Public folder. However, I have found the next best thing. Thank you to

http://www.outlookcode.com

for the code examples.

The following code creates the Task and at the same time calls the procedure to get the Public Folder name. The newly created Task is then moved to the Exchange Public folder.

Public Sub CreateTask()
Dim outObj As Outlook.Application
Dim outTask As Outlook.TaskItem
Dim objFolder As Outlook.MAPIFolder

Set outObj = CreateObject("outlook.application")
Set objFolder = GetFolder("Public Folders/All Public Folders/Common Tasks")
'The "GetFolder" procedure is used to set what the objFolder is.
'Replace what's between the " " with your own folder list.
Set outTask = outObj.CreateItem(olTaskItem)

With outTask
.Subject = "Remember to call " & Forms!frmEmailSendingTest.FirstName _
& " " & Forms!frmEmailSendingTest.LastName
.DueDate = Date + 1
.ReminderSet = True
.Body = "Phone number is: " & Forms!frmEmailSendingTest.Phone
.Owner = GetMailboxUserName
End With

outTask.Move objFolder
'Apirl 20, 2004. This code does move the task to the public folder
'However it does not display the task before it is moved.

Set outObj = Nothing
Set outTask = Nothing
Set objFolder = Nothing

End Sub

Public Function GetFolder(strFolderPath As String) As Outlook.MAPIFolder
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim colFolders As Outlook.Folders
Dim objFolder As Outlook.MAPIFolder
Dim arrFolders() As String
Dim I As Long

On Error Resume Next

strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objFolder = objNS.Folders.Item(arrFolders(0))

If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
Set objFolder = Nothing


End Function

Public Function GetMailboxUserName()
Dim objApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objInbox As Outlook.MAPIFolder
Dim strName As String
Dim intPos As Integer

Set objApp = CreateObject("Outlook.application")
Set objNS = objApp.GetNamespace("Mapi")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

strName = objInbox.Parent.Name
intPos = InStr(1, strName, "Mailbox -", vbTextCompare)

If intPos > 0 Then
GetMailboxUserName = Mid(strName, 11, Len(strName) - 10)
End If

Set objInbox = Nothing
Set objNS = Nothing
Set objApp = Nothing

End Function

Hope this helps,
Michael