I have 5 accounts in outlook and have 20 favorite folders taken from those that I would like to appear in the same order each time I open outlook. The order they appear each time is pretty random. Is there a way to run a script on opening that will sort the folders into same order each time I open
I have looked through the Office VBA reference and cant find anything there that helps
You can sort the folders in the Outlook UI by explicitly setting the PR_SORT_POSITION property on each subfolder, for example, the following code shows the sort position of each folder in Outlook:
For Each folder In objMainFolder.Folders
folder_index_property = folder.PropertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x30200102")
folder_index = folder.PropertyAccessor.BinaryToString(folder_index_property)
MsgBox folder.Name & ", " & CInt("&h0" & folder_index(0))
Next
To set up the sort order you need to use the PropertyAccessor.SetProperty method which sets the property specified by SchemaName to the value specified by Value. If the property does not exist and the SchemaName contains a valid property specifier, then SetProperty creates the property and assigns the value specified by Value. If the property does exist and SchemaName is valid, then SetProperty assigns the property with the value specified by Value.
Sub DemoPropertyAccessorSetProperty()
Dim myProp As String
Dim myValue As Integer
Dim oMail As Outlook.MailItem
Dim oPA As Outlook.PropertyAccessor
'Get first item in the inbox
Set oMail = _
Application.Session.GetDefaultFolder(olFolderInbox).Items(1)
myProp = "http://schemas.microsoft.com/mapi/proptag/0x30200102"
myValue = 1
'Set value with SetProperty call
'If the property does not exist, then SetProperty
'adds the property to the object when saved.
'The type of the property is the type of the element
'passed in myValue.
On Error GoTo ErrTrap
Set oPA = oMail.PropertyAccessor
oPA.SetProperty myProp, myValue
'Save the item
oMail.Save
Exit Sub
ErrTrap:
Debug.Print Err.Number, Err.Description
End Sub
Related
Private Sub UserForm_Initialize()
On Error GoTo ErrorHandler
Dim ns As Outlook.NameSpace
Dim inbox As Outlook.folder
Dim subfolder As Outlook.folder
Set ns = Application.GetNamespace("MAPI")
Set inbox = ns.Folders("**email#email.co.uk**").Folders("Inbox")
Set subfolder = inbox.Folders("PENIEL GREEN N.HOME").Folders("2023")
CheckSubfolders subfolder.Folders
If ComboBox1.ListCount > 0 Then
ComboBox1.ListIndex = 0
End If
If ComboBox2.ListCount > 0 Then
ComboBox2.ListIndex = 0
End If
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " - " & Err.Description
End Sub
Private Sub CheckSubfolders(subfolders As Outlook.Folders)
For Each subfolder In subfolders
If Not subfolder Is Nothing Then
If Mid(subfolder.Name, Len(subfolder.Name) - 7, 8) = "PGNH Rx" Then
ComboBox1.AddItem subfolder.Name
ElseIf Mid(subfolder.Name, Len(subfolder.Name) - 10, 11) = "PGNH Triage" Then
ComboBox2.AddItem subfolder.Name
End If
End If
Next
End Sub
I'm trying to get 2 combiboxs to populate with the folders nested under one of my email inboxs. currently the folders are under inbox > folder > folder > targertfolder.
With the target folder being folders with suffix checked under the Sub Checksubfolders.
Currently generates an error: -2147221233 - The attempted operation failed. An object could not be found.
The user form is still then generated with no folders present in either combi box.
First of all, you need to consider adding On Error Resume Next in the CheckSubfolders method to make sure that code will continue iterating over all other folders in the loop if any folder is failed, so your combo-boxes will be filled with folder names anyway.
But I suppose the error comes from the following piece of code:
Set inbox = ns.Folders("**email#email.co.uk**").Folders("Inbox")
Set subfolder = inbox.Folders("PENIEL GREEN N.HOME").Folders("2023")
Use the NameSpace.Stores property which returns a Stores collection object that represents all the Store objects in the current profile. After you've found the required store (see Store.DisplayName) you can get the Inbox folder by 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.
Finally, try to remove the On Error GoTo ErrorHandler line in the code to find out which line of code exactly gives the error, so you could fix that quickly.
Is there a method in VBA to achieve the same effect of right-clicking on a folder in the folder pane and selecting 'Sort Subfolders A to Z'?
As a comparison, the code below from Microsoft.com sorts Items in a folder; however, it does not appear that the .Sort method used in this code is available for the Folders object like it is for the Items object.
Sub SortByDueDate()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myItem As Outlook.TaskItem
Dim myItems As Outlook.Items
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderTasks)
Set myItems = myFolder.Items
myItems.Sort "[DueDate]", False
For Each myItem In myItems
MsgBox myItem.Subject & "-- " & myItem.DueDate
Next myItem
End Sub
Additionally, it does not appear that there are any methods available for moving folders in the tree.
Is more extensive code required to replicate the native 'Sort Subfolders A to Z' action with VBA?
Can this be achieved with PropertyAssessor and, if so, what is the proper syntax for setting the PR_SORT_POSITION property? For example, the code below results in an error, as commented in the code.
Sub Example()
Dim myProp As String
Dim myValue As Variant
Dim oFolder As Folder
Set oFolder = Application.Session.GetDefaultFolder(olFolderInbox)
myProp = "http://schemas.microsoft.com/mapi/proptag/0x30200102"
myValue = "FD7F"
oFolder.PropertyAssessor.SetProperty myProp, myValue 'Run-time error '438': Object doesn't support this property or method
End Sub
The Outlook object model doesn't provide any property or method to sort folders. You may find the NavigationPane object helpful. See Customizing the Navigation Pane for more information.
You can sort the folders in the Outlook UI by explicitly setting the PR_SORT_POSITION property on each subfolder - see Get folder list ordered as displayed
I posted my code here because this was high in Google results and all other threads were closed
https://answers.microsoft.com/en-us/outlook_com/forum/all/sorting-outlook-subfolders-z-a/9aef727c-510c-49e0-869d-4234373b71d7
https://answers.microsoft.com/en-us/outlook_com/forum/all/sort-order-of-subfolders/a3b55181-4f5a-43c1-82b3-94eb68a8407b
I've made custom VBA code to sort subfolders Z-A - it will load the folder order [unfortunately you still need to order it A-Z within outlook] and then reverse it so it is Z-A
I needed to quickly adjust a tonne of folders and couldn't find any code anywhere, so I quickly made the below to help patch the issue.
I didn't have the time to write lots of detail about how it works.
Known issues with the code:
It doesn't always sort the first folder. No idea why.
It doesn't seem to like it when you're looking at the list of subfolders - minimise it then run the code
This code is used to reverse the sorting of subfolders under Inbox, you'll need to adjust as required.
Sub sortZA()
Dim email_name: email_name = "email#emails.com" 'write the name of the mailbox as it appears in outlook
Dim objMainFolder As Outlook.Folder
Dim Folders As Outlook.Folders
Dim Folderx As Outlook.Folder
Dim sort_order, sort_order_b, arr
Set arr = CreateObject("System.Collections.ArrayList")
Set arr_sorted = CreateObject("System.Collections.ArrayList")
dim found_folder: found_folder=0
Set Folders = Application.ActiveExplorer.Session.Folders
For Each Folderx In Folders
If LCase(Folderx.Name) = LCase(email_name) Then
Set objMainFolder = Folderx.Folders("Inbox") 'adjust as required. Add more folders via .folders("name")
found_folder=1
End If
Next
if found_folder =0 then
msgbox "the email folder with the name '" & email_name & "' was not found"
exit sub
end if
Dim reloadFolder As Outlook.Folder
Dim propertyAccessor As Outlook.propertyAccessor
For Each Folderx In objMainFolder.Folders
' if there is an error, then there might not be any order data. Try reordering them manually. Also make sure loading the email as the main profile instead of as an additional mailbox.
'On Error Resume Next
Set propertyAccessor = Folderx.propertyAccessor
sort_order = propertyAccessor.BinaryToString(propertyAccessor.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x30200102"))
arr.Add Folderx.Name & "##~~##" & sort_order
arr_sorted.Add Folderx.Name & "##~~##" & sort_order
Next
arr.Sort 'keep A-Z (the original list from outlook isn't in A-Z order)
arr_sorted.Sort 'make A-Z
arr_sorted.Reverse 'make Z-A
Dim t, a, b, i, t2, a2, b2
i = 0
For Each arr_folder In arr
t = Split(arr_folder, "##~~##")
a = t(0) 'which folder name?
b = t(1) 'what is the original order? [should already be A-Z]
Set Folders = Application.ActiveExplorer.Session.Folders
For Each Folderx In Folders
'On Error Resume Next
If LCase(Folderx.Name) = LCase(email_name) Then
Set reloadFolder = Folderx.Folders("Inbox").Folders(a)
End If
Next
t2 = Split(arr_sorted(i), "##~~##")
a2 = t2(0) 'which folder name?
b2 = t2(1) 'what is the reversed order?
Set propertyAccessor = reloadFolder.propertyAccessor
propertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x30200102", propertyAccessor.StringToBinary(b2)
i = i + 1
Next
End Sub
Additional Notes: I did try experimenting with applying ordering data manually. I couldn't get it to work properly. All the binary converting code wasn't producing the correct values, and I ended up using HEX(). Here is an example of what I was doing:
Dim custom_order As Long
custom_order = 15
For Each arr_folder In arr
'the array only contains a list of folder names.. we need to load the folder in outlook to process it again. The below line of code loads the main email inbox, then the subfolder from the array [different from the above code]
Set reloadFolder = Application.Session.GetDefaultFolder(olFolderInbox).Folders(arr_folder)
Set propertyAccessor = reloadFolder.propertyAccessor
hexval = Hex(custom_order)
propertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/proptag/0x30200102", propertyAccessor.StringToBinary(hexval)
custom_order = custom_order + 1
Next
End Sub
I need to create custom filters in Outlook to save me from having to manually adjust the filter setting each time, preferably with VBA.
Below is my attempt. I inserted the message box line to check the correct items are being restricted. On running the macro I get a number of message boxes displayed with "1" indicating to me that it is working as expected (message box appears for each 'In Progress' item).
For Each Task_List In CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(13).Items.Restrict("[Status]='In Progress'")
MsgBox Task_List.Status
sFilter = "[Status]=Task_List.Status"
Next
However, the tasks in the task folder are not filtered, all the tasks are displayed regardless of criteria.
What am I missing from my code? Or am I completely barking up the wrong tree.
Thanks, and apologies in advance for the simplistic question.
Once you manually set up different views you can get to them this way.
Where the view is named for instance "In Progress"
Sub TaskView_InProgress()
' No error if the view does not exist
' No error if not currently in Tasks folder
ActiveExplorer.CurrentView = "In Progress"
End Sub
This demonstrates how to access the In Progress tasks. Albeit much less helpful than a view if you have many tasks.
Private Sub task_Filter()
' Folders may contain any type of item
Dim myItem As Object
Dim myItems As items
Dim resItems As items
Dim myTaskFolder As Folder
Dim sFilter As String
Dim msgPrompt As String
Set myTaskFolder = Session.GetDefaultFolder(olFolderTasks)
Set myItems = myTaskFolder.items
sFilter = "[Status]='In Progress'"
Set resItems = myItems.Restrict(sFilter)
For Each myItem In resItems
If myItem.Class = OlTask Then
myItem.Display
End If
Next
End Sub
This sub worked great for my purpose. I wanted to also input a string in the search field of the task window from excel. So I loaded the string to the clipboard and used send keys to "Ctrl E" (enter search field) then "Ctrl V" paste. This routine turns num lock off. So I added a toggle for that.
Sub btn_GotoTask()
Set cl = New clsClient
' Folders may contain any type of item
Dim myItem As Object
Dim myItems As items
Dim resItems As items
Dim myTaskFolder As Folder
Dim sFilter As String
Dim msgPrompt As String
On Error GoTo outlookError
Set myTaskFolder = Session.GetDefaultFolder(olFolderTasks)
myTaskFolder.Display
SetClipboard cl.Pol
'Activate task window
myTaskFolder.Application.ActiveWindow
SendKeys "^{e}"
SendKeys "^{v}"
SendKeys "{NUMLOCK}"
Exit Sub
outlookError:
MsgBox "Outlook may not be open"
End Sub
For each Outlook Contact I need to grab the name and value of each field.
Eg.
FirstName: John
LastNmae: Doe
... etc.
How can I go about this without referencing each field individually?
With the code below I can print the name of each property, but I don't know how to print the value. The line that is commented out throws an error: "Invalid procedure call or argument"
Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Dim Contact As ContactItem
Dim i As Integer
For Each Contact In ContactsFolder.Items
id = Contact.EntryID
Debug.Print Contact.FirstName
Debug.Print id
For i = 0 To Contact.ItemProperties.Count - 1
Debug.Print Contact.ItemProperties(i).Name
'Debug.Print Contact.ItemProperties(i).Value
Next
Next
Here is an example of grabbing all the names of all address lists in the current session.
You can find all the properties for the object at https://msdn.microsoft.com/en-us/library/office/dn320232.aspx
For obtaining the object's properties' names and evaluating them, see a TypeLib reference. (http://visualbasic.happycodings.com/applications-vba/code19.html may or may not apply)
Sub getContact()
Dim ContactsFolder As Folder
Set ContactsFolder = Session.GetDefaultFolder(olFolderContacts)
Dim Contact As ContactItem
Dim i As Integer
For Each Contact In ContactsFolder.Items
ID = Contact.EntryID
Debug.Print Contact.FirstName
Debug.Print ID
For i = 0 To Contact.ItemProperties.Count - 1
Debug.Print Contact.ItemProperties(i).Name
' Doesn't work for object propertieties, like application.
' (Do Error Handling)
Deubg.Print CallByName(Contact, Contact.ItemProperties(i).Name, VbGet)
Next
Next
End Sub
I want to implement an VBA application, which uses the selected object (E-mail, task, folder).
My try with Application.ActiveExplorer.Selection.Item(i_item) seems to return only mails, tasks, calender entries or notes but never an folder (e.g. 'Inbox\').
When the user selects an e-mail, and then starts the VBA macro, the solution Application.ActiveExplorer.Selection.Item(i_item) delivers the desired results.
However, if the last item picked by the Outlook user was an folder (e.g. 'Sent Mails'). And the VBA makro started afterward, than the macro should recive the Folder Item (without additional user interaction). This is currently not the case. The code above still delivers the e-mail, or task.
How do I check, if the last selection was on an folder (not an e-mail, etc)?
How do I access the Folder item?
If this is not possible I will switch back to Pickfolder (like proposd by Darren Bartrup-Cook) but this is not me prefred solution.
I want to get the selected folder in order to change its icon, so our code is somehow the same.
I noticed that Application.ActiveExplorer.Selection.Item(i_item) it is not perfect, since it throws an exception for empty folders or on calendar etc.
So I use Application.ActiveExplorer.CurrentFolder.DefaultMessageClass (Application.ActiveExplorer.NavigationPane.CurrentModule.Name or Application.ActiveExplorer.NavigationPane.CurrentModule.NavigationModuleType) in order to figure out where I actually am.
By that approach it is easy to get current selected folder
Dim folder As Outlook.MAPIFolder
Dim folderPath As String, currItemType As String
Dim i As Integer
currItemType = Application.ActiveExplorer.CurrentFolder.DefaultMessageClass
If currItemType = "IPM.Note" Then 'mail Item types https://msdn.microsoft.com/en-us/library/office/ff861573.aspx
Set folder = Application.ActiveExplorer.CurrentFolder
folderPath = folder.Name
Do Until folder.Parent = "Mapi"
Set folder = folder.Parent
folderPath = folder.Name & "\" & folderPath
Loop
Debug.Print folderPath
End If
haven't got an problem with it yet. In your case, you can store the selection in a global variable, so you always know which folder was selected last.
This procedure will ask you to select the folder.
If you interrupt the code and examine the mFolderSelected or MySelectedFolder then you should be able to work something out:
Public Sub Test()
Dim MySelectedFolder As Variant
Set MySelectedFolder = PickFolder
End Sub
Public Function PickFolder() As Object
Dim oOutlook As Object 'Outlook.Application
Dim nNameSpace As Object 'Outlook.Namespace
Dim mFolderSelected As Object 'Outlook.MAPIFolder
On Error GoTo ERROR_HANDLER
Set oOutlook = CreateObject("Outlook.Application")
Set nNameSpace = oOutlook.GetNameSpace("MAPI")
Set mFolderSelected = nNameSpace.PickFolder
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The commented out code will return only email folders. '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If Not mFolderSelected Is Nothing Then
' If mFolderSelected.DefaultItemType = 0 Then
Set PickFolder = mFolderSelected
' Else
' Set PickFolder = Nothing
' End If
Else
Set PickFolder = Nothing
End If
Set nNameSpace = Nothing
Set oOutlook = Nothing
On Error GoTo 0
Exit Function
ERROR_HANDLER:
Select Case Err.Number
Case Else
MsgBox "Error " & Err.Number & vbCr & _
" (" & Err.Description & ") in procedure PickFolder."
Err.Clear
End Select
End Function
NB: This was written to be used in Excel and has late binding - you'll need to update it to work in Outlook (no need to reference Outlook for a start).