Outlook VBA 2013 Access Parent Folders - vba

Okay, I was reading a tutorial on how to access parent folders outside of the Inbox and noticed that it was using "Set". To my knowledge, this command is deprecated and seems so whenever I have tried to use it in my code.
http://blogs.technet.com/b/heyscriptingguy/archive/2006/08/03/how-can-i-get-access-to-a-mail-folder-that-isn-t-a-subfolder-of-my-outlook-inbox.aspx
' Set Outlook parameters
objOutlook = CreateObject("Outlook.Application")
iNameSpace = myOlApp.GetNamespace("MAPI") ' Set current NameSpace
Dim oExp As Outlook.Explorer
Dim oSel As Outlook.Selection
oExp = objOutlook.ActiveExplorer
oSel = oExp.Selection
Dim strFolderName As Object
Dim objInbox As Outlook.Folder
Dim objMailbox As Outlook.Folder
Dim objFolder As Outlook.Folder
Const olFolderInbox = 6
objInbox = iNameSpace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Folders.Parent()
objMailbox = iNameSpace.Folders(strFolderName)
objFolder = objMailbox.Folders("Europe")
When trying the code above, I get a type error: Additional information: Type mismatch, on this line:
objMailbox = iNameSpace.Folders(strFolderName)
When I change this to an "Object", I get the same error.
Any Idea what I am doing wrong?

To access the parent of the Inbox folder, try iNameSpace.GetDefaultFolder(olFolderInbox).Parent
To access a folder on the same level as the Inbox, try iNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders.Item("The Folder name")

The following code will not work.
strFolderName = objInbox.Folders.Parent()
The Folders collection does't provide the Parent method.
objMailbox = iNameSpace.Folders(strFolderName)
The Folders property doesn't accept an object arguments.

Related

Custom user properties field in Search folder view

I created a custom user property field. I am able to add this field in all folders, except a Search folder.
Sub AddStatusProperties()
Dim objNamespace As NameSpace
Dim objFolder As Folder
Dim objProperty As UserDefinedProperty
Dim oNameSpace As Object 'Outlook.Namespace
Dim oStores As Object 'Outlook.Stores
Dim oStore As Object 'Outlook.Store
Dim oFolder As Object 'Outlook.folder
Set objNamespace = Application.GetNamespace("MAPI")
For Each objFolder In objNamespace.Folders
With objFolder.UserDefinedProperties
Set objProperty = .Add("MyNotes1", olText, True)
End With
Next
End Sub
This is the error message:
"Run-time error 440: you don't have appropriate permission to perform this operation"
when I added below line.
Set oFolder = Session.Stores.Item("xxxxx#xxx.com").GetSearchFolders("Inbox 2")
With oFolder.UserDefinedProperties
Set objProperty = .Add("MyNotes1", olText, True)
End With
Do you know what I am doing wrong or if there is a workaround?
This is to be expected - folder properties are stored in a hidden (associated) message in the folder. But search folders cannot contains any messages - they only point to the search results from other folders, a message cannot be created there.

GetSharedDefaultFolder - Subfolder Access Error

I am having trouble getting my Outlook VBA code to recognize the subfolder in my Shared Tasks.
What I'm trying to do is create a macro that will automatically create a task in the department Shared Task folder. Tried Googling a variety of solutions to no avail. The code goes as follows:
Dim objApp As Outlook.Application
Dim defaultTasksFolder As Outlook.MAPIFolder
Dim subFolder As Outlook.MAPIFolder
Dim objNS As Outlook.NameSpace
Dim objMail As MailItem
Dim objItm As TaskItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objMail = Outlook.Application.ActiveExplorer.Selection.Item(1)
Dim objOwner As Outlook.Recipient
Set objOwner = objNS.CreateRecipient("name#email.com")
objOwner.Resolve
If objOwner.Resolved Then
Set defaultTasksFolder = objNS.GetSharedDefaultFolder(objOwner, olFolderTasks)
subFolder = defaultTasksFolder.Folders("TestFolder") **ERROR OCCURS HERE - OBJECT COULD NOT BE FOUND**
Set objItm = subFolder.Items.Add(olTaskItem)
With objItm
.Subject = "Name- " & objMail.Subject
.StartDate = objMail.ReceivedTime
.Body = objMail.Body
End With
objItm.Save
MsgBox ("Task Created for e-mail: " & vbCrLf & objMail.Subject)
End If
End Sub
It errors out on subFolder = defaultTasksFolder.Folders("TestFolder"), saying that the object could not be found. I double and tripled checked the folder name.
Any ideas what might be causing this error? Thank you!!
First of all, add the Logon method before accessing MAPI, it will log to the profile if Outlook has just been started. If it is already running it will not affect anything. Then try to add both mailboxes as delegate stores (see the Advanced tab of the Exchange account properties dialog). You should see both mailboxes.
Finally, I'd try to iterate over all folders before to make sure the folder exists. Also, I'd recommend checking the recipient's name.
Keep in mind that Outlook might cache only the default folders, but not their suborders.
Can you see and access the subfolder in Outlook?

MailItem.SaveAs when referencing with EntryID

I'm developing a drag and drop of a MailItem from Outlook (I know it's a MailItem and not any other type) into an Access memo field. Trying to call SaveAs on a MailItem object.
I get
Error 287 - Application-defined or object-defined error.
I've tried using the namespace, not using the namespace, using .Item, etc.
Here's my current code:
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olNs As Outlook.NameSpace
Set olNs = olApp.GetNamespace("MAPI")
Dim olMail As Outlook.MailItem
Set olMail = olNs.GetItemFromID(olNs.Application.ActiveExplorer.Selection(1).EntryID)
olMail.SaveAs strPathAndFile, Outlook.OlSaveAsType.olMSG
Access 2010, Outlook 2010 both 32 bit. Win 7 machine is 64 bit.
Tried it on an all 32-bit machine, same error.
Tried Dmitry's code below, same error.
Finally got this working using Dmitry Streblechenko's awesome Redemption library. Thanks!
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Dim olNs As Outlook.NameSpace
Set olNs = olApp.GetNamespace("MAPI")
Dim oRDOSession As Redemption.RDOSession
Set oRDOSession = CreateObject("Redemption.RDOSession")
oRDOSession.MAPIOBJECT = olNs.Application.Session.MAPIOBJECT
If Not oRDOSession.LoggedOn Then oRDOSession.Logon
Dim oMsgItem As Redemption.RDOMail
Set oMsgItem = oRDOSession.GetMessageFromID(olNs.Application.ActiveExplorer.Selection(1).EntryID)
strPathAndFile = "some\path\" & UniqueValueStr(Now()) & ".msg"
oMsgItem.SaveAs strPathAndFile
Why do you need to use Redemption?
I don't see any difference between using the OOM and Redempton.
Why do you need to use the GetItemFromID method in the code?
olNs.GetItemFromID(olNs.Application.ActiveExplorer.Selection(1).EntryID)
You have already got a reference to the selected object in the explorer window:
olNs.Application.ActiveExplorer.Selection(1)
Also I'd suggest breaking the chaing of calls and declaring each property or method call on a separate line.

Run-time Error, Library not registered with macro importing attachments from outlook subfolders

I have the following code which I believe should work to save attachments from an Outlook subfolder to the specified path, before emptying the subfolder.
Sub Downloadattachments()
Dim applOutlook As Outlook.Application
Dim ns As Namespace
Dim inbox As MAPIFolder
Dim item As Object
Dim atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim SubFolder As MAPIFolder
Dim SubSubFolder As MAPIFolder
Dim VariableName As Name
Set ns = GetNamespace("MAPI")
Set inbox = ns.GetDefaultFolder(olFolderInbox)
Set SubFolder = inbox.Folders("Paul")
Set SubSubFolder = SubFolder.Folders("Soja")
i = 0
If SubSubFolder.Items.Count = 0 Then
MsgBox
Else: End If
If SubSubFolder.Items.Count > 0 Then
For Each item In SubSubFolder.Items
For Each atmt In item.attachments
FileName = "\\homefolder5\bases" & atmt.FileName
atmt.SaveAsFile FileName
i = i + 1
item.Delete
Next atmt
Next item
End If
End Sub
Unfortunately I don't get past the line Set ns = GetNamespace("MAPI") before encountering the run-time error stating "Automation error: Library not registered". To clarify, I have the Microsoft Outlook 14.0 Object Library activated, along with other basic libraries. I think this must be something different.
I apologize if this is a really simple thing that I am overlooking, but I would appreciate whatever guidance you could give me!
Where do you run the VBA macro?
Dim applOutlook As Outlook.Application
It looks like you didn't initialize the applOutlook object in the code. If you develop an Outlook VBA macro, you can use the Application property:
Set applOutlook = Application
Set ns = applOutlook.GetNamespace("MAPI")
In case if you automate Outlook you need to create a new instance of the Application class. See How to automate Outlook from another program for more information.

VBA, Outlook, Seeing 'People's Calendars

I am tring to programmatically (with VBA) to access calendars others share with me. They are listed in my Outlook under 'People's Calendars.' I have searched the Web for this and all the suggestions have done little more than confuse me. How can I get a listing of all the calendars shared to me, and then one calendar in specific, from among the 'People's Calendars'?
Check out the returned values from the following code. It searches for a person by name, same way as when you are typing a recipient into a new email, and then grabs that persons shared calendar and enumerates all shared appointments.
Dim _namespace As Outlook.NameSpace
Dim _recipient As Outlook.Recipient
Dim calendarFolder As Outlook.Folder
Set _namespace = Application.GetNamespace("MAPI")
Set _recipient = _namespace.CreateRecipient(name)
_recipient.Resolve
If _recipient.Resolved Then
Set calendarFolder = _namespace.GetSharedDefaultFolder(_recipient, olFolderCalendar)
'This would display the calendar on the screen:
'calendarFolder.Display
Dim oItems As Outlook.Items
Set oItems = calendarFolder.Items
'oItems is now a set of all appointments in that person's calendar
'Play on
End if
I think this gets closer. It came from Sue Mosher's outstanding Microsoft Outlook 2007 Programming: Jumpstart for Power Users and Administrators. I hope she doesn't mind.
Sub ShowOtherUserCalFolders()
Dim objOL As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim objExpCal As Outlook.Explorer
Dim objNavMod As Outlook.CalendarModule
Dim objNavGroup As Outlook.NavigationGroup
Dim objNavFolder As Outlook.NavigationFolder
Dim objFolder As Outlook.Folder
Dim colExpl As Outlook.Explorers
Dim objExpl As Outlook.Explorer
Set objOL = Application
Set objNS = objOL.Session
Set colExpl = objOL.Explorers
Set objExpCal = _
objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
Set objNavMod = objExpCal.NavigationPane.Modules. _
GetNavigationModule(olModuleCalendar)
Set objNavGroup = objNavMod.NavigationGroups. _
GetDefaultNavigationGroup(olPeopleFoldersGroup)
For Each objNavFolder In objNavGroup.NavigationFolders
Set objFolder = objNavFolder.Folder
Set objExpl = _
colExpl.Add(objFolder, olFolderDisplayNormal)
objExpl.Activate
objExpl.WindowState = olMaximized
objExpl.WindowState = olMinimized
Next
Set objOL = Nothing
Set objNS = Nothing
Set objNavMod = Nothing
Set objNavGroup = Nothing
Set objNavFolder = Nothing
Set objFolder = Nothing
Set colExpl = Nothing
Set objExpl = Nothing
End Sub
Just a suggestion to help people who may be trying to use the ShowOtherUserCalFolders() code posted here. This code will create multiple hidden instances of outlook which if run many times can eventual bog down your machine. Instead of creating a new Outlook.application you can call the current open one (outlook must be open for this to work).
To do this replace Dim objOL As Outlook.Application with Dim objOL as Object and Set objOL = Application with Set myOlApp = GetObject(, "Outlook.Application")
Also make sure you close the objExpCal Explorer as this will also create a hidden instance of outlook, add objExpCal.Close to the end of your code.