VBA: How to iterate through Outlook Inbox subfolder - vba

I am attempting to pull all emails from an Outlook inbox subfolder and then pull the subject of each mail item.
I am defining the folders as such:
'Outlook folder- deifinitions
Dim olApp As Outlook.Application
Set olApp = New Outlook.Application
Dim olNs As Outlook.Namespace
Set olNs = olApp.GetNamespace("MAPI")
Dim olRecip As Outlook.Recipient
Set olRecip = olNs.CreateRecipient("email#outlook.com")
Dim Inbox As Outlook.MAPIFolder
Set Inbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
Dim InboxSubfolder As Outlook.Folder
Set InboxSubfolder = Inbox.Folders("To Be Logged")
I am getting
Run-time Error '-2147221219 (8004011d)' The operation failed because
of a registry or installation problem. Restart Outlook and try again.
Debug always highlights this line.
Set Inbox = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
This is on a fresh install of both Windows and Outlook. I have restarted both Outlook and the computer. Any suggestions?

If the Inbox folder comes from the account configured in Outlook you need to use the NameSpace.GetDefaultFolder method which returns a Folder object that represents the default folder of the requested type for the current profile; for example, obtains the default Inbox folder for the user who is currently logged on.
Dim olApp As Outlook.Application
Set olApp = New Outlook.Application
Dim olNs As Outlook.Namespace
Set olNs = olApp.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
Dim InboxSubfolder As Outlook.Folder
Set InboxSubfolder = Inbox.Folders("To Be Logged")
Also you may find the required store in Outlook in case of multiple accounts configured using the Store.GetDefaultFolder method which returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument.
This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile.

Related

Why does VBA code fail when setting a new instance of an Outlook Application object?

The first sub routine runs fine when called upon application startup, while the second does not bring up Outlook and instead takes a minute or two, culminating in an error. The only difference is that in the "set" statement, I put the word "New". I am aware that this means it is trying to open up a new instance of the Outlook client, while one is already running, but why wouldn't there be a way for the Outlook to deal with the request for a new application while one is already running, or use the new instance instead of the existing instance?
Sub SaveAttachment1_Initialize()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox)
End Sub
Sub SaveAttachment1_Initialize()
Dim olApp As Outlook.Application
Dim olNS As Outlook.NameSpace
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olItems = olNS.GetDefaultFolder(olFolderInbox)
End Sub
If you are running in Outlook VBA, that line must be
Set olApp = Application
If not, the second one is correct. The first one makes no sense - you are assigning a variable to type (?).

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?

Outlook VBA Access Folders in Shared Mailbox

I have some VBA code in Outlook which behaves perfectly for the main Mailbox - however the same code is struggling when I add a secondary mailbox - this is Outlook 2016.
It seems to be struggling with reading the sub folders - I can get it to read mail items in the Inbox, but not the sub folders.
Code :
Dim sharedemail As Outlook.Recipient
Dim myOlApp As New Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.MAPIFolder
Dim myDestFolder Outlook.MAPIFolder
Dim strSubject As String
Dim i As Integer
Set myNameSpace = myOlApp.GetNamespace("MAPI")
Set sharedemail = myNameSpace.CreateRecipient("recip#domain.com")
Set myInbox = myNameSpace.GetSharedDefaultFolder(sharedemail, olFolderInbox)
For itemCount = myInbox.items.Count To 1 Step -1 'Iterates from the end backwards
Set item = myInbox.items(itemCount)
strSubject = UCase(item.Subject)
Select Case True
Case InStr(strSubject, UCase("Holiday Request")) > 0
'Set destination folder
Set myDestFolder = myInbox.Folders("HolidayRequests")
'move the email out of inbox
item.Move myDestFolder
End Select
Next
It stalls at the Set myDestFolder line as it can't seem to select that sub folder - as I say same code seems to work fine in main Inbox?
Thanks
Keep in mind that Outlook keeps shared default folders in the primary OST file, and it does not sync the subfolders.
You can either
Uncheck the "Download shared folders" checkbox
Use Extended MAPI (C++ or Delphi) - that would be fairly complex as you'd need to retrieve the autodiscover XML for that mailbox and construct the store entry id appropriately.
use Redemption (I am its author) - its version of RDOSession.GetSharedDefaultFolder returns an online version of the folder (RDOFolder) with all its subfolders.

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.

Get reference to additional Inbox

I'm using Outlook 2007 - and have my main mailbox: Tait, Mark
I have also added another mailbox to my profile: Procurement, Request
Both appear as top level folders within Outlook:
Mailbox - Tait, Mark>
-Conversation History
-Deleted Items
-Drafts
-Inbox
-Junk E-Mail
Mailbox - Procurement, Request
--Conversation History
--Deleted Items
--Drafts
--Inbox
--Junk E-Mail
I can get a reference to my default Inbox (Tait, Mark) using:
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
How do I get a reference to the Inbox in the "Procurement, Request" mailbox?
Something like this should do the trick
Dim objNS As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Set objNS = GetNamespace("MAPI")
Set objFolder = objNS.Folders("Procurement, Request")
Set objFolder = objFolder.Folders("Inbox")
This link has some useful code for handling different Inboxes - it may be of interest
Dim olNS As NameSpace
Dim InputFolder As Outlook.MAPIFolder
Set olNS = Outlook.Application.GetNamespace("MAPI")
' Get reference to folder in users Mailbox for Input
Set InputFolder = olNS.Folders("Procurement, Request").Folders("Inbox")
' all the emails in the shared inbox are represented by:
InputFolder.Items
Use Namespace.GetSharedDefaultFolder. It will work even if the mailbox is not opened in the current profile. You still need to have the right to open the mailbox and access the folder in question of course:
Set vNamespace = Application.GetNamespace("MAPI")
set vRecipient = vNamespace.CreateRecipient("Procurement, Request")
if vRecipient.Resolve Then
set vFolder = vNamespace.GetSharedDefaultFolder(vRecipient, olFolderInbox)
End If
If you need to open the other user's mailbox (with all off its folders), you can use Redemption (I am its author) and its RDOSession.GetSharedMailbox method:
set Session = CreateObject("Redemption.RDOSession")
Session.MAPIOBJECT = Application.Session.MAPIOBJECT
set Store = Session.GetSharedMailbox("Procurement, Request")
set vFolder = Store.GetDefaultFolder(olFolderInbox)
MsgBox "The address of the mailbox owner: " & Store.Owner.Address