Check if an outlook folder exists; if not create it - vba

Question

Im trying to check if a folder exists; if it does not then create it. The below is just throwing a run-time error.
Sub AddClose()
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim myNewFolder As Outlook.Folder
Set myNameSpace = Application.GetNamespace("MAPI")
Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)
If myFolder.Folders("Close") = 0 Then
myFolder.Folders.Add("Close").Folders.Add ("EID1")
myFolder.Folders("Close").Folders.Add ("EID2")
myFolder.Folders("Close").Folders.Add ("EID3")
End If
End Sub
However, If the folder exists then the below works...
If myFolder.Folders("Close") > 0 Then
MsgBox "Yay!"
End If
Why? What can I do to correct the problem?

Answer 1

Firstly, you are comparing the result of the myFolder.Folders("Close") call (which is supposed to return a MAPIFolder object) with an integer (0). You need to use Is Nothing or Is Not Nothing operator.
Secondly, MAPIFolder.Folders.Item() raises an exception if the folder with a given name is not found. You need to trap that exception (as ugly as it is in VBA) and either check the Err.Number value or check that the return object is set:
On Error Resume Next
set subFolder = myFolder.Folders.Item("Close")
if subFolder Is Nothing Then
set subFolder = myFolder.Folders.Add("Close")
End If

Answer 2

I do not understand: If myFolder.Folders("Close") = 0 Then. myFolder.Folders("Close") is a folder and I would not have thought of comparing it against zero. Do you have a reference to a site where this functionality is explained because I would like to understand it?
I wish to create a folder if it does not exist often enough to have written a function. My function does not have ideal parameters for your requirement but it works. I offer it as tested code that does what you want or as a source of ideas for your own code.
Sub DemoGetCreateFldr shows how to use the function GetCreateFldr to achieve the effect I believe you seek.
I do not use GetDefaultFolder because, on my system, it returns a reference to a store I do not use. “Outlook Data File” is Outlook’s default store but the wizard created a separate store for each of my two email addresses. In Set Store = Session.Folders("Outlook Data File"), replace "Outlook Data File" with the name of the store holding the Inbox for which you want to create subfolders.
The first call of GetCreateFldr creates folder “Close” if it does not exist and then creates folder “EID1”. I save the reference to the folder, and use Debug.Print to demonstrate it returns the correct reference.
For folders “EID2” and “EID3”, I do not save the reference which matches your code.
If folders “Close”, “EID1”, “EID2” and “EID3” exist, GetCreateFldr does not attempt to create them although it still returns a reference.
Hope this helps.
Sub DemoGetCreateFldr()
Dim FldrEID1 As Folder
Dim FldrNameFull(1 To 3) As String
Dim Store As Folder
Set Store = Session.Folders("Outlook Data File")
FldrNameFull(1) = "Inbox"
FldrNameFull(2) = "Close"
FldrNameFull(3) = "EID1"
Set FldrEID1 = GetCreateFldr(Store, FldrNameFull)
Debug.Print FldrEID1.Parent.Parent.Parent.Name & "|" & _
FldrEID1.Parent.Parent.Name & "|" & _
FldrEID1.Parent.Name & "|" & _
FldrEID1.Name
FldrNameFull(3) = "EID2"
Call GetCreateFldr(Store, FldrNameFull)
FldrNameFull(3) = "EID3"
Call GetCreateFldr(Store, FldrNameFull)
End Sub
Public Function GetCreateFldr(ByRef Store As Folder, _
ByRef FldrNameFull() As String) As Folder
' * Store identifies the store, which must exist, in which the folder is
' wanted.
' * FldrNameFull identifies a folder which is or is wanted within Store.
' Find the folder if it exists otherwise create it. Either way, return
' a reference to it.
' * If LB is the lower bound of FldrNameFull:
' * FldrNameFull(LB) is the name of a folder that is wanted within Store.
' * FldrNameFull(LB+1) is the name of a folder that is wanted within
' FldrNameFull(LB).
' * FldrNameFull(LB+2) is the name of a folder that is wanted within
' FldrNameFull(LB+1).
' * And so on until the full name of the wanted folder is specified.
' 17Oct16 Date coded not recorded but must be before this date
Dim FldrChld As Folder
Dim FldrCrnt As Folder
Dim ChildExists As Boolean
Dim InxC As Long
Dim InxFN As Long
Set FldrCrnt = Store
For InxFN = LBound(FldrNameFull) To UBound(FldrNameFull)
ChildExists = True
' Is FldrNameFull(InxFN) a child of FldrCrnt?
On Error Resume Next
Set FldrChld = Nothing ' Ensure value is Nothing if following statement fails
Set FldrChld = FldrCrnt.Folders(FldrNameFull(InxFN))
On Error GoTo 0
If FldrChld Is Nothing Then
' Child does not exist
ChildExists = False
Exit For
End If
Set FldrCrnt = FldrChld
Next
If ChildExists Then
' Folder already exists
Else
' Folder does not exist. Create it and any children
Set FldrCrnt = FldrCrnt.Folders.Add(FldrNameFull(InxFN))
For InxFN = InxFN + 1 To UBound(FldrNameFull)
Set FldrCrnt = FldrCrnt.Folders.Add(FldrNameFull(InxFN))
Next
End If
Set GetCreateFldr = FldrCrnt
End Function

Answer 3

Its not a good coding practice to user on error.
I would recommend you to traverse through the folders.
Then if a certain name is not found create it.
The code below part of my macro I use.
It looks for a "Duplicates" under inbox.
It intentionally doesn't do this recursively.
Sub createDuplicatesFolder()
Dim folderObj, rootfolderObj, newfolderObj As Outlook.folder
Dim NameSpaceObj As Outlook.NameSpace
duplicatefolder = False
For Each folderObj In Application.Session.Folders
If folderObj.Name = "Duplicates" Then duplicatefolder = True
Next
If duplicatefolder = False Then
Set rootfolderObj = NameSpaceObj.GetDefaultFolder(olFolderInbox)
Set newfolderObj = rootfolderObj.Folders.Add("Duplicates")
End Sub

Answer 4

A slow way. Depends on number of folders.
Sub checkFolder()
Dim folderObj As folder
Dim rootfolderObj As folder
Dim newfolderObj As folder
Dim checkFolderName As String
' Check and add in the same location
Set rootfolderObj = Session.GetDefaultFolder(olFolderInbox)
' Check and add the same folder name
checkFolderName = "checkedFolder"
For Each folderObj In rootfolderObj.folders
If folderObj.name = checkFolderName Then
Set newfolderObj = rootfolderObj.folders(checkFolderName)
'Reduces the search time, if the folder exists
Exit For
End If
Next
If newfolderObj Is Nothing Then
Set newfolderObj = rootfolderObj.folders.add(checkFolderName)
End If
Debug.Print newfolderObj.name
End Sub

Answer 5

A fast way. Add without checking existing folders.
Sub addFolder_OnErrorResumeNext()
Dim rootFolder As folder
Dim addFolder As folder
Dim addFolderName As String
Set rootFolder = Session.GetDefaultFolder(olFolderInbox)
addFolderName = "addFolder"
On Error Resume Next
' Bypass expected error if folder exists
Set addFolder = rootFolder.folders.add(addFolderName)
' Return to normal error handling for unexpected errors
' Consider mandatory after On Error Resume Next
On Error GoTo 0
' In other cases the expected error should be handled.
' For this case it can be ignored.
Set addFolder = rootFolder.folders(addFolderName)
Debug.Print addFolder.name
End Sub