On Error Resume Next to ignore Error 440 when attempting to create an existing folder

Question

Step 1:
I want to make a folder, and if it fails (it may already exist), I want to ignore and move on.

Sub MakeFolder()

'declare variables
Dim outlookApp As Outlook.Application
Dim NS As Outlook.NameSpace

'set up folder objects    
Set outlookApp = New Outlook.Application
Set outlookApp = New Outlook.Application
Set NS = outlookApp.GetNamespace("MAPI")
Set objOwner = NS.CreateRecipient("[email protected]")
objOwner.Resolve
Set outlookInbox = NS.GetSharedDefaultFolder(objOwner, olFolderInbox)

'make a folder, maybe
Dim newFolder 
On Error Resume Next
Set newFolder = outlookInbox.Folders.Add("myNewFolder")
On Error GoTo -1
On Error GoTo 0
End Sub

I get an error:

If the folder doesn't exist, it creates it.

Step2:
I have a list of folders (about 60) that may change over time. Because of this, I'd like to run a script checking for new folders and then create them.

For Each fol In folders
    On Error Resume Next
    Set newFolder = outlookInbox.Folders.Add(fol)
    If Err.Number <> 0 Then
        On Error GoTo -1
    Else:
        Debug.Print fol & " created "
    End If
    On Error GoTo 0
Next ID

Same here, the outlookInbox.Folders.Add() throws errors regardless of the return next, if it can't create that folder.

Answer 1

Now that you fixed your IDE, you could use the following code

Option Explicit
Public Sub Example()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.Folder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Dim SubFolder As Outlook.Folder

    '// SubFolder Name
    Dim FolderName As String
    FolderName = "myNewFolder"

    '// Check if folder exist else create one
    If FolderExists(Inbox, FolderName) = True Then
        Debug.Print "Folder Exists"
        Set SubFolder = Inbox.Folders(FolderName)
    Else
        Set SubFolder = Inbox.Folders.Add(FolderName)
    End If

End Sub


'//  Function - Check folder Exist
Private Function FolderExists(Inbox As Folder, FolderName As String)
    Dim Sub_Folder As MAPIFolder

    On Error GoTo Exit_Err
    Set Sub_Folder = Inbox.Folders(FolderName)

    FolderExists = True
        Exit Function

Exit_Err:
    FolderExists = False

End Function