The purpose of this code is to go through a shared folder in outlook and tell me the email subject and the received time and enter that into a spreadsheet. I made a version of this code that worked before on my own inbox, so I know that all of the excel parts work just fine. Once I knew that that worked I shifted it to the shared inbox (which is what I actually need) so I could tell where the errors are.
I've been fiddling with this for ages and from what I can tell this is getting hung up on the subfolders in this shared inbox. I've gone into the properties of the folder in outlook itself and it insists that these are the only folders, nonetheless, I've tried also having the name of the shared inbox and even the inbox itself as other combinations but none of that works. I have the reference libraries for outlook active, and like I said the code worked on my personal email.
The error that I'm getting is '-2147221233 (8004010f)' Attempted operation failed. An object could not be found. This is happening on line 17 (Set olFolder = olFolder.Folders("MY TEAM'S FOLDER").Folders("THE FOLDER I WANT")) where the folder is set.
The structure that I want is 'my department's shared email'> that email's inbox > my team's folder > the subfolder I want As far as I can see this should do that, but it won't. Seeing as this is the file path as far as I can tell, and the email is correct, and the code worked on my inbox before... I'm at a loss.
Sub GetFromOutlook()
Worksheets("Sheet1").Activate
Dim OutlookApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim Folder As Outlook.Folder
Dim OutlookMail As Variant
Dim i As Integer
Dim olFolder As Folder
Dim olRecip As Outlook.Recipient
Set OutlookApp = New Outlook.Application
Set olNs = OutlookApp.GetNamespace("MAPI")
Set olRecip = olNs.CreateRecipient("SHARED EMAIL ADDRESS")
Set olFolder = olNs.GetSharedDefaultFolder(olRecip, olFolderInbox)
Set olFolder = olFolder.Folders("MY TEAM'S FOLDER").Folders("THE FOLDER I WANT")
i = 1
For Each OutlookMail In olFolder.Items
Cells(i + 1, 1) = OutlookMail.Subject
Cells(i + 1, 2) = OutlookMail.ReceivedTime
i = i + 1
Next OutlookMail
Set Folder = Nothing
Set olNs = Nothing
Set OutlookApp = Nothing
End Sub
The problematic line of code contains multiple property and method calls:
Set olFolder = olFolder.Folders("MY TEAM'S FOLDER").Folders("THE FOLDER I WANT")
I'd recommend breaking the chain of property and method calls by declaring each of them on a separate line of code. Thus, you will find the problematic call.
Anyway, to find whether such folder exists in a shared store I'd suggest iterating over all subfolders and getting their names, so you may find the required folder following that way.
For Each uFolder In olFolder.Folders
If uFolder.Name = "MY TEAM'S FOLDER" Then
MsgBox "MY TEAM'S FOLDER is found!"
End If
Next uFolder
Related
This script is suppose to loop through my outlook folder inbox-> Work Request
Then for each mail item in that folder download each attachment and save if to a file location.
Code seems to work fine in finding the folder and the correct emails however it is giving me an error message on the following line of code saying "Run-Time Error '-2147024891(80070005) Cannot save the attachment. You don't have the appropriate permissions to perform this operation."
I have tried multiple save location including our external cloud drive and my personal desktop. Currently the code is saving to my desktop and still says I do not have appropriate permissions to save. Any help would be greatly appreciated.
olAtt.SaveAsFile ("C:\Users\John Smith\Desktop\WOR Email Download")
The rest of the script is depicted below.
Option Explicit
Sub Download_Outlook_Attachemtns()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim MailItem As Outlook.MailItem
Dim olAtt As Outlook.Attachment
Dim FileLocation As String
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
'single folder link to hidden sheet folders([admin].[Mailbox].text)
Set olFolder = olNS.Folders("JohnSmith#work.com")
Set olFolder = olFolder.Folders("Inbox")
Set olFolder = olFolder.Folders("Work Requests")
For Each olItem In olFolder.Items
If olItem.Class = olMail Then
Set MailItem = olItem
'Debug.Print MailItem.Subject
For Each olAtt In MailItem.Attachments
If MailItem.ReceivedTime > ThisWorkbook.Worksheets("Email_Info").Range("C6").Value Then
olAtt.SaveAsFile ("C:\Users\John Smith\Desktop\WOR Email Download")
'olAtt.SaveAs Filename:=Application.GetSaveAsFilename
End If
Next olAtt
End If
Next olItem
'Set olFolder = Nothing
'Set olNS = Nothing
End Sub
First of all, instead of iterating over all items in the folder:
For Each olItem In olFolder.Items
If olItem.Class = olMail Then
Set MailItem = olItem
You can find all items with attachments in the folder and iterate over them only. The Find/FindNext or Restrict methods of the Items class do the magic. Read more about these methods in the articles I wrote for the technical blog:
How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
How To: Use Restrict method to retrieve Outlook mail items from a folder
For example, you can use the following search criteria (VBA syntax):
Filter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:hasattachment" & Chr(34) & "=1"
Also it makes sense to optimize the code by changing the order of conditions:
For Each olAtt In MailItem.Attachments
If MailItem.ReceivedTime > ThisWorkbook.Worksheets("Email_Info").Range("C6").Value Then
Instead of checking the received time of the email for each attachment you can check it once for the email before iterating over attached files or, better yet, you may include another condition to the search criteria by using the logical AND operator in the search string.
Finally, you may try to check the Attachment.Type property value before trying to save anything to the disk. The property returns an OlAttachmentType constant indicating the type of the specified object.
You must include the file name besides the folder name. Currently, you are telling Outlook to save to a file conflicting with an existing folder name ("WOR Email Download"), hence the "no access" error - the file cannot be created since its name conflicts with an existing folder name. Change your code to
if olAtt.Type = olByValue Then
olAtt.SaveAsFile "C:\Users\John Smith\Desktop\WOR Email Download\" & olAtt.FileName
End If
On my laptop it works, however for the team the code works only sometimes. They get below error message.
It is supposed to connect to a specific Outlook folder.
When I reduce code to
Set Folder = Ns.GetSharedDefaultFolder(olShareName, olFolderInbox) '// works fine
then there is no issue on their side, however when variable is extended to specific folder it works 1 out of 10 times.
References are set in Excel, folders names are correct because it works on my laptop.
in line
`
Sub macro()
'declare variable
Dim olApp As Outlook.Application
Dim Ns As Outlook.Namespace
Dim Folder As Outlook.MAPIFolder
Dim olShareName As Outlook.Recipient
Dim olMailItem As Outlook.MailItem
'clear objects
Set olApp = Nothing
Set Ns = Nothing
Set olShareName = Nothing
'set outlook variable
Set olApp = New Outlook.Application
Set Ns = olApp.GetNamespace("MAPI")
Set olShareName = Ns.CreateRecipient("xxx#xx.com") /// Owner's email address
Set Folder = Ns.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("SHAREPOINT COO").Folders("COO") '// doesn't work
'Set Folder = Ns.GetSharedDefaultFolder(olShareName, olFolderInbox) '// works fine
Set Items = Folder.Items
end sub
The error means the folder does not exist. Keep in mind that Namespace.Folders returns the top level folders of all stores in the profile. Unless you have a mailbox (not a folder) named "Inbox", that line will fail.
If you want the Inbox folder, use Namespace.GetDEfaultFolder(olFolderInbox) instead.
Use the Recipient.Resolve method which attempts to resolve a Recipient object against the Address Book before calling the NameSpace.GetSharedDefaultFolder method.
Set olShareName = Ns.CreateRecipient("xxx#xx.com") /// Owner's email address
olShareName.Resolve
Set Folder = Ns.GetSharedDefaultFolder(olShareName, olFolderInbox)
Also I'd recommend breaking the chain of property or method calls by declaring each property or method call on a separate line of code. Thus, you will be able to find out which property or method fails.
I'd like to collect some email count data from Outlook using Excel VBA. In addition to my personal email, I also have access to other mailboxes account/stores(?). The label on the Outlook mailbox/accounts are HR,Marketing, Accounting. I'd like to loop through the folders in these mailboxes/stores and perform some task.
When I write a for loop through Sessions.Accounts, it only accesses my default mailbox (i.e. not HR,Marketing,Accounting). It looks like I can access my non-default mailboxes if I loop through Session.Stores:
Sub test()
Dim olApp As Outlook.Application
Set olApp = Outlook.Application
For Each acct In olApp.Session.Stores
MsgBox acct
'how can I access folders and emails within these Stores?
End Sub
This returns message boxes with HR, Marketing, Accounting. I am not able to select the inbox or other folders within these non-default mailboxes though.
For my default mailbox, I was able to get it:
Sub default_email_count()
Dim olApp As Outlook.Application
Dim objNS As Outlook.Namespace
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = olbNS.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("sample_folder")
Count = olFolder.Items.Count
Msgbox Count
'this code successfully outputs the count of emails in my default mailbox within the folder "sample folder"
How can I extend the above code to work across other Stores and not just my default mailbox?
Thanks in advance.
The following code shows how to enumerate all folders on all stores for an Outlook session.
The code sample begins by getting all the stores for the current session using the NameSpace.Stores property of the current session, Application.Session.
For each store of this session, it uses Store.GetRootFolder to obtain the folder at the root of the store.
For the root folder of each store, it iteratively calls the EnumerateFolders procedure until it has visited and displayed the name of each folder in that tree.
Sub EnumerateFoldersInStores()
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oRoot As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oRoot = oStore.GetRootFolder
Debug.Print (oRoot.FolderPath)
EnumerateFolders oRoot
Next
End Sub
Private Sub EnumerateFolders(ByVal oFolder As Outlook.Folder)
Dim folders As Outlook.folders
Dim Folder As Outlook.Folder
Dim foldercount As Integer
On Error Resume Next
Set folders = oFolder.folders
foldercount = folders.Count
'Check if there are any folders below oFolder
If foldercount Then
For Each Folder In folders
Debug.Print (Folder.FolderPath)
EnumerateFolders Folder
Next
End If
End Sub
If the mailboxes are already in your profile, use the Namespace.Stores collection. Default folders can be accessed using Store.GetDefaultFolder (instead of Namespace.GetDefaultFolder).
You can also use Namespace.GetSharedDefaultFolder - it takes Recipient object as one of its parameters (you can get it from Namespace.CreateRecipient).
Each day, I and a coworker get a mail with the same format.
I want to import the time/date of the mail and the subject if the mail meets the following requirements:
Subject contains "Order"
Received time >= (Based on range)
Received time <= (Based on range)
Specific Sender name (Based on range)
The code works when I use my own Outlook account. When a coworker tries to run it, the condition of the specific sender name gives an error
438 'Object doesn't support this property or method'.
When I remove the condition of the specific sender name, the code works on my coworker's account. The sender name in my coworker's account is the same as in my own Outlook account.
(Obviously, the strMailboxName and the Folders have been changed into the names my coworker uses in Outlook before trying to run the code.)
Note: my coworker has Calendar appointments in the Folder, which I don't have (but they are not sent by SenderName). Furthermore, my coworker receives mails about other subjects from SenderName.
Sub Outlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim strMailboxName As String
Dim i As Integer
strMailboxName = "OutlookName" 'Name of mailaccount
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNameSpace("MAPI")
Set Folder = Session.Folders(strMailboxName)
Set Folder = Folder.Folders("FolderName") 'Name of folder
i = 1
For Each OutlookMail In Folder.Items
If InStr(OutlookMail.Subject, "Order") > 0 And OutlookMail.ReceivedTime >= Range("start_date").Value And OutlookMail.ReceivedTime <= Range("end_date") And OutlookMail.Sender = Range("Sender") Then
Range("Date_and_time").Offset(i, 0).Value = OutlookMail.ReceivedTime
Range("Date_and_time").Offset(i, 0).VerticalAlignment = xlTop
Range("Subject").Offset(i, 0).Value = OutlookMail.Subject
Range("Subject").Offset(i, 0).VerticalAlignment = xlTop
i = i + 1
End If
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
Why does this occur and how do I overcome this problem? Is this a code problem or perhaps a problem with some sort of settings of my coworker's mail account?
Firstly, you should never loop through all items in a folder - use Items.Find/FindNext or Items.Restrict.
Secondly, you can have items other than MailItem in a folder - you can also have ReportItem (for NDRs) and MeetingItem (for appointment invitations/updates).
Do check that OutlookMail.Class property = 43 (olMailItem) first.
I have written the following code in Excel VBA that opens an email with the given subject if located in the default inbox folder in Outlook.
However, I would like to search for this email in all inbox subfolders.
Because the code will be used by several users, I do not know the number and the name of their outlook inbox subfolders. Any ideas on how I could search this email in all subfolders?
Sub GetEmail()
Dim OutApp as Object
Dim Namespace as Object
Dim Folder as Object
Dim myMail as Object
Set OutApp = CreateObject("Outlook.Application")
Set Namespace = OutApp.GetNamespace ("MAPI")
Set Folder = Namespace.GetDefaultFolder(6)
Set myMail = Folder.Items.Find ("[Subject] = ""Test""")
myMail.Display
End Sub
The below code cycles through all folders in Outlook, to the level one beneath the Inbox. You can just look at the inbox by specifying the initial folder to look at. Thus you can search the folder as you loop through. you can add further sub folders by looping deeper, or by saying folders.count > X.
I have always found Outlook from Excel frustrating so have made this Early Bound to make coding easier. This means that you will need to go to Tool/References and add Microsoft Outlook 16(x).0 Object Library
You can change it back to late bound after coding, as early binding will give you IntelliSense and make life a whole lot easier.
Sub GetEmail()
Dim OutApp As Outlook.Application
Dim Namespace As Outlook.Namespace
Dim Mfolder As Outlook.MAPIFolder
Dim myMail As Outlook.Items
Dim Folder As Outlook.MAPIFolder
Dim SubFolder As Outlook.MAPIFolder
Dim UserFolder As Outlook.MAPIFolder
Set OutApp = New Outlook.Application
Set Namespace = OutApp.GetNamespace("MAPI")
On Error Resume Next
For Each Folder In Namespace.Folders
For Each SubFolder In Folder.Folders
For Each UserFolder In SubFolder.Folders
Debug.Print Folder.Name, "|", SubFolder.Name, "|", UserFolder.Name
Next UserFolder
Next SubFolder
Next Folder
On Error GoTo 0
End Sub
The on error is to skip any issues with outlook mapping Archive pst files.