How to move Outlook subfolder to a different parentfolder with Excel VBA - excel

How do I move an Outlook subfolder (and all items in it) to a different parent folder?
Example:
Subfolder to move: Example Event 2017
EXISTING:
Outlook\Personal Folders\Audits\Example Event 2017
AFTER CODE RUNS:
Outlook\Personal Folders\Audits\Past Events\Example Event 2017
Thank you!

In Excel, this will move the subfolder "test" from its parent folder "new" to make it a subfolder of "processed". (needs reference to Outlook)
Sub moveSubFolderToNewFolder()
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.Namespace
Dim objSourceFolder As Outlook.MAPIFolder
Dim objDestFolder As Outlook.MAPIFolder
Dim objFolder As Folder
Set objOutlook = Outlook.Application
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objSourceFolder = objNamespace.GetDefaultFolder(olFolderInbox)
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox).Folders("new").Folders("test")
Set objDestFolder = objNamespace.GetDefaultFolder(olFolderInbox).Folders("processed")
objFolder.MoveTo objDestFolder
Set objDestFolder = Nothing
End Sub

Related

How to loop through items in a folder?

CONTEXT: I'm trying to first check if mails in a folder ("pending") are read. If the mail is read, move it to another folder ("done").
Then, for the remaining mails in "pending", save the attachments and mark the mail as "read".
PROBLEM: When I try to loop through the items in the folder it drops
Run-time error 438:
The object doesn't support this property or method
CODE:
Sub MoveInbox2Reviewed()
Dim OutlookApp As Outlook.Application
Dim ONameSpace As Object
Dim OItem As Outlook.MailItem
Dim OFolderSrc As Object
Dim OFolderDst As Object
Dim Path As String
Set OutlookApp = New Outlook.Application
Set ONameSpace = OutlookApp.GetNamespace("MAPI")
Set OFolderSrc = ONameSpace.GetDefaultFolder(olFolderInbox).Folders("pending")
Set OFolderDst = ONameSpace.GetDefaultFolder(olFolderInbox).Folders("done")
Path = "C:\Users\..."
For Each OItem In OFolderSrc
If OItem.UnRead = False Then
OItem.Move OFolderDst
End If
Next
For Each OItem In OFolderSrc
OItem.Attachments.SaveAsFile Path & Attachment.DisplayName
OItem.UnRead = False
Next
End Sub
Firstly, you are looping through the folders. not items. You need OFolderSrc.Items.
Secondly, you should never loop through all items in a folder, use Items.Restrict:
For Each OItem In OFolderSrc.Items.Restrict("[Unread] = true")

Import Outlook Subfolder email to Excel using VBA

I copied the code from Youtube and made the necessary changes to reflect what I need it to do.
It works fine in importing emails to Excel, however, it only works with the emails received in my Inbox.
I don't want to import all the emails I receive but instead, I only have to choose which ones to import. My work around was to move the emails that I want to import to another folder (Inbox subfolder called "OnBoarding").
This is where I am stuck. I couldn't make it work to import emails in the Inbox subfolder "OnBoarding"
Here is the code that I use:
Private Sub Application_Startup()
Dim outlookapp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookapp = Outlook.Application
Set objectNS = outlookapp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Items
I tried to change the path to this:
Private Sub Application_Startup()
Dim outlookapp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Set outlookapp = Outlook.Application
Set objectNS = outlookapp.GetNamespace("MAPI")
Set inboxItems = objectNS.GetDefaultFolder(olFolderInbox).Folders("OnBoarding")
But it is not working.
Please help on what I am doing wrong.
Thank you!
You are trying to set an instance of the Items class to a Folders one. Instead, you need to get a folder instance and then retrieve a corresponding Items object:
Dim outlookapp As Outlook.Application
Dim objectNS As Outlook.NameSpace
Dim subfolder As Outlook.Folders
Dim onBoardingFolderItems as Outlook.Items
Set objectNS = Application.GetNamespace("MAPI")
Set subfolder = objectNS.GetDefaultFolder(olFolderInbox).Folders("OnBoarding")
Set onBoardingFolderItems = subfolder.Items

How to access an Outlook folder from an Excel macro

I have VBA code in Excel to select the main Outlook inbox. I would like to select any folder or subfolder in that inbox.
For example, I would like to select the subfolder ALD in this screenshot of my main inbox:
I have another email address in Outlook with folders and subfolders. I would like to select any folder or subfolder of this other email address. For example, I have another email address called xxxx#yyyy.com and a folder aaaa and inside a subfolder bbbb. How would I select the subfolder bbbb?
Sub OpenOutlookFolder()
Dim xOutlookApp As Outlook.Application
Dim xNameSpace As Outlook.Namespace
Dim xFolder As Outlook.Folder
Dim xFolderType As OlDefaultFolders
On Error Resume Next
Set xOutlookApp = New Outlook.Application
Set xNameSpace = xOutlookApp.Session
Set xFolder = xNameSpace.GetDefaultFolder(olFolderInbox
xFolder.Display
Set xFolder = Nothing
Set xNameSpace = Nothing
Set xOutlookApp = Nothing
Exit Sub
End Sub
Something along the lines of:
Dim ThisNamespace As Outlook.NameSpace: Set ThisNamespace = Application.GetNamespace("MAPI")
Dim Inbox As Outlook.MAPIFolder: Set Inbox = ThisNamespace.GetDefaultFolder(olFolderInbox)
Dim BaseFolder As Outlook.MAPIFolder: Set BaseFolder = Inbox '.Folders("SubFolder1\SubFolder2...")
For direct subfolder access, uncomment within the last line and update the path
If you want to create a folder structure which is searchable/editable then my answer in this question may be of interest: How can one iterate through the subfolders of a subfolder of a shared mail inbox folder?
Finally by checking again the link Get reference to additional Inbox, I managed to modify my macro in order it works and does as I want. Please find the code below:
Sub OpenOutlookFolderworks()
Dim xOutlookApp As Outlook.Application
Dim xNameSpace As Outlook.Namespace
Dim xFolder As Outlook.Folder
Dim vRecipient As Outlook.MAPIFolder
Dim xFolderType As OlDefaultFolders
On Error Resume Next
Set xOutlookApp = New Outlook.Application
Set xNameSpace = xOutlookApp.Session
Set xFolder = xNameSpace.GetDefaultFolder(olFolderInbox)
Set xFolder = xFolder.Folders("payment office")
Set xFolder = xFolder.Folders("JIRA")
xFolder.display
Set xFolder = Nothing
Set xNameSpace = Nothing
Exit Sub
End Sub

Working with folders other than inbox in Outlook

Using Excel VBA I can retrieve the email body and subject from Inbox.
Set ObjO = CreateObject("Outlook.Application")
Set olNs = ObjO.GetNamespace("MAPI")
Set objFolder = olNs.GetDefaultFolder(6)
For Each item1 In objFolder.Items
Dim sa, bc
bc = item1.ReceivedTime
sa = Format(item1.ReceivedTime, "dd-MM-yyyy")
If item1.UnRead And item1.SenderEmailAddress = "harshahowrang#gmail.com" And sa = spa Then
Here Defaultfolder(6) is for Inbox.
All mails come into CRM folder so I need to change the folder path.
I tried other numbers which are not working and don't point to CRM folder in Outlook mailbox.
How do I point to CRM folder?
Simply use
Set objfolder = olNs.GetDefaultFolder(olFolderInbox) _
.Parent.Folders("CRM")
Full Example
Option Explicit
Private Sub Example()
Dim ObjO As Object
Set ObjO = CreateObject("Outlook.Application")
Dim olNs As Object
Set olNs = ObjO.GetNamespace("MAPI")
Dim objfolder As Object
Set objfolder = olNs.GetDefaultFolder(olFolderInbox) _
.Parent.Folders("CRM")
objfolder.Display
End Sub
You should be able to access the folder like this:
Set objFolder = olNs.GetDefaultFolder(6).Folders("CRM")
Else check the named folders in Inbox for it:
Set objFolder = olNs.GetDefaultFolder(6)
For Each oFolder In objFolder.Folders
Debug.Print oFolder.Name
Next
Edit: After seeing the image you posted,
To access folders on the same level as Inbox you can do:
Set objFolder = olNs.GetDefaultFolder(6).Parent.Folders("CRM")
Or iterate through .Parent.Folders to get the CRM Folder name.

Excel vba: Looping through all subfolders in Outlook email to find an email with certain subject

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.

Resources