Send a task to specific shared folder in Outlook from Access 2013

Hi,

Using Access & Outlook 2013.  What I am trying to do is send a task to an exchange shared folder called P/O Tasks under the user admin1.  I can get it to send to my default Tasks folder but that's as far as I can get, I've spent hours googleing to no avail, this is my VBA:

Private Sub createPOTask_Click()
Dim outLookApp As Outlook.Application
Dim OutlookTask As Outlook.TaskItem

Set outLookApp = CreateObject("outlook.application")
Set OutlookTask = outLookApp.CreateItem(olTaskItem)

With OutlookTask
   .Subject = [qtysold] & " x " & [description] & " is required for " & Forms![or_ordermain_edit]![companyname] & " " & Forms![or_ordermain_edit]![customername] & " for Order No: " & Forms![or_ordermain_edit]![ordernumber]
    .Body = ""
    .DueDate = Forms![or_ordermain_edit]![collectiondate]
    .Save
End With
    MsgBox "Task have been sent to PO Tasks successfully.", vbInformation, "Set Task Confirmed" '

Open in new window


I don't know what the VBA is to select the correct P/O Tasks folder under the admin1 user

Any help greatly appreciated.

Thanks
palsopAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Russell FoxDatabase DeveloperCommented:
I'm just looking at this page to tweak your case into this:
Private Sub createPOTask_Click()
Dim outLookApp As Outlook.Application
Dim OutlookTask As Outlook.TaskItem

Set outLookApp = CreateObject("outlook.application")
'----------------------------------------------------
Set ns = olApp.GetNamespace("MAPI") 
ns.Logon 
Set Recip = ns.CreateRecipient("admin1") 
Set SharedFolder = ns.GetSharedDefaultFolder(Recip, olFolderTasks) 
'----------------------------------------------------
'Set OutlookTask = outLookApp.CreateItem(olTaskItem)
Set OutlookTask = SharedFolder.Items.Add("P/O Tasks") 

With OutlookTask
   .Subject = [qtysold] & " x " & [description] & " is required for " & Forms![or_ordermain_edit]![companyname] & " " & Forms![or_ordermain_edit]![customername] & " for Order No: " & Forms![or_ordermain_edit]![ordernumber]
    .Body = ""
    .DueDate = Forms![or_ordermain_edit]![collectiondate]
    .Save
End With
    MsgBox "Task have been sent to PO Tasks successfully.", vbInformation, "Set Task Confirmed" '

Open in new window

palsopAuthor Commented:
Hi,

Thanks for your reply to this...I get an error "Run-time error '424' Object required" which relates to Set NS = olApp.GetNamespace("MAPI")

Do you know what would cause that?

Thanks.
palsopAuthor Commented:
Got a bit further and got rid of the object required error.  Now get an object could not be found error on this line: Set OutlookTask = SharedFolder.items.Add("P/O Tasks")
Dim outLookApp As Outlook.Application
Dim OutlookTask As Outlook.TaskItem
Dim NSpace As Object

Set outLookApp = CreateObject("outlook.application")

Set NSpace = outLookApp.GetNamespace("MAPI")
NSpace.Logon
Set Recip = NSpace.CreateRecipient("admin1")
Set SharedFolder = NSpace.GetSharedDefaultFolder(Recip, olFolderTasks)

Set OutlookTask = SharedFolder.items.Add("P/O Tasks")

With OutlookTask
   .Subject = [qtysold] & " x " & [description] & " is required for " & Forms![or_ordermain_edit]![companyname] & " " & Forms![or_ordermain_edit]![customername] & " for Order No: " & Forms![or_ordermain_edit]![ordernumber]
    .Body = ""
    .DueDate = Forms![or_ordermain_edit]![collectiondate]
    .Save
End With
    MsgBox "Task have been sent to PO Tasks successfully.", vbInformation, "Set Task Confirmed"

Open in new window


Seems it cant find the P/O Tasks folder.
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

Russell FoxDatabase DeveloperCommented:
Try replacing "admin1" below with the email address for the admin1 user:
'Set Recip = NSpace.CreateRecipient("admin1")
Set Recip = NSpace.CreateRecipient("admin1@yourcompany.com")

Open in new window

palsopAuthor Commented:
Hi,

That didnt work either - here is the latest version of the code:

Dim outLookApp As Outlook.Application
Dim OutlookTask As Outlook.TaskItem
Dim NS As Outlook.NameSpace

Set outLookApp = CreateObject("outlook.application")

Set NS = outLookApp.GetNamespace("MAPI")
NS.Logon
Set Recip = NS.CreateRecipient("admin1@yc.uk.com")
Set SharedFolder = NS.GetSharedDefaultFolder(Recip, olFolderTasks)


'MsgBox ([Recip] & [SharedFolder])

Set OutlookTask = SharedFolder.items.Add("PO Tasks")

With OutlookTask
   .Subject = [qtysold] & " x " & [description] & " is required for " & Forms![or_ordermain_edit]![companyname] & " " & Forms![or_ordermain_edit]![customername] & " for Order No: " & Forms![or_ordermain_edit]![ordernumber]
    .Body = ""
    .DueDate = Forms![or_ordermain_edit]![collectiondate]
    .Save
End With
    MsgBox "Task have been sent to PO Tasks successfully.", vbInformation, "Set Task Confirmed"

Open in new window

Russell FoxDatabase DeveloperCommented:
Try this (changed items.Add to .CreateItem(olTaskItem):
Dim outLookApp As Outlook.Application
Dim OutlookTask As Outlook.TaskItem
Dim NS As Outlook.NameSpace

Set outLookApp = CreateObject("outlook.application")

Set NS = outLookApp.GetNamespace("MAPI")
NS.Logon
Set Recip = NS.CreateRecipient("admin1@yc.uk.com")
Set SharedFolder = NS.GetSharedDefaultFolder(Recip, olFolderTasks)


'MsgBox ([Recip] & [SharedFolder])

Set OutlookTask = SharedFolder.CreateItem(olTaskItem)

With OutlookTask
   .Subject = [qtysold] & " x " & [description] & " is required for " & Forms![or_ordermain_edit]![companyname] & " " & Forms![or_ordermain_edit]![customername] & " for Order No: " & Forms![or_ordermain_edit]![ordernumber]
    .Body = ""
    .DueDate = Forms![or_ordermain_edit]![collectiondate]
    .Save
End With
    MsgBox "Task have been sent to PO Tasks successfully.", vbInformation, "Set Task Confirmed"

Open in new window

palsopAuthor Commented:
Hi,

Finally got to the bottom of this, if anyone is interested here is my final code that works:

Private Sub Command76_Click()

On Error Resume Next

Dim myApp As Outlook.Application
Dim myNP As Outlook.NameSpace
Dim myRecip As Outlook.Recipient
Dim TaskFolder As Outlook.Folder
Dim myTask As Outlook.TaskItem

Set myApp = CreateObject("Outlook.Application")
Set myNP = myApp.GetNamespace("MAPI")
Set myRecip = myNP.CreateRecipient("admin1@yc.uk.com")
Set TaskFolder = myNP.GetSharedDefaultFolder(myRecip, olFolderTasks).Parent.Folders("P/O Tasks")

myRecip.Resolve

If myRecip.Resolved Then
    Set myTask = TaskFolder.items.Add(olTaskItem)

    With myTask
        .Subject = [qtysold] & " x " & [description] & " is required for " & Forms![or_ordermain_edit]![companyname] & " " & Forms![or_ordermain_edit]![customername] & " for Order No: " & Forms![or_ordermain_edit]![ordernumber]
        .Body = "Your body"
        .DueDate = Forms![or_ordermain_edit]![collectiondate]
        '.Save '''Don't Display Direct Save> Just Remove [']Before & Display > Just Add [']Before
        .Display '''Don't Display > Just Add [']Before
    End With
End If
Set myApp = Nothing
If Err.Number <> 0 Then
    MsgBox "Error No# " & Err.Number & vbCrLf & Err.description
Else
    MsgBox "Task have been sent to P/O Tasks successfully.", vbInformation, "Set Task Confirmed"
End If


End Sub

Open in new window


Thanks

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
palsopAuthor Commented:
Because it works and other suggestions didnt
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.