Проверьте, существует ли папка Outlook; если не создать

Во-первых, вы сравниваете результат вызова myFolder.Folders("Close") (который должен возвращать объект MAPIFolder) с целым числом (0). Вам нужно использовать оператор Is Nothing или Is not Nothing.

Во-вторых, MAPIFolder.Folders.Item() вызывает исключение, если папка с заданным именем не найдена. Вам нужно перехватить это исключение (такое же уродливое, как и в VBA) и либо проверить значение Err.Number, либо проверить, установлен ли возвращаемый объект:

On Error Resume Next
set subFolder = myFolder.Folders.Item("Close")
if subFolder Is Nothing Then
  set subFolder = myFolder.Folders.Add("Close")
End If

Я не понимаю: If myFolder.Folders("Close") = 0 Then. myFolder.Folders("Close") это папка и мне бы не пришло в голову сравнивать ее с нулем. У вас есть ссылка на сайт, где объясняется эта функциональность, потому что я хотел бы понять это?

Я хочу создать папку, если она не существует достаточно часто, чтобы написать функцию. Моя функция не имеет идеальных параметров для вашего требования, но она работает. Я предлагаю его как проверенный код, который делает то, что вы хотите, или как источник идей для вашего собственного кода.

Sub DemoGetCreateFldr показывает, как использовать функцию GetCreateFldr для достижения эффекта, который, как я полагаю, вы ищете.

Я не использую GetDefaultFolder, потому что в моей системе он возвращает ссылку на хранилище, которое я не использую. «Файл данных Outlook» — это хранилище Outlook по умолчанию, но мастер создал отдельное хранилище для каждого из двух моих адресов электронной почты. В Set Store = Session.Folders("Outlook Data File") замените «Файл данных Outlook» на имя хранилища, в котором находится папка «Входящие», для которой вы хотите создать подпапки.

Первый вызов GetCreateFldr создает папку «Закрыть», если она не существует, а затем создает папку «EID1». Я сохраняю ссылку на папку и использую Debug.Print, чтобы продемонстрировать, что она возвращает правильную ссылку.

Для папок «EID2» и «EID3» я не сохраняю ссылку, соответствующую вашему коду.

Если папки «Закрыть», «EID1», «EID2» и «EID3» существуют, GetCreateFldr не пытается их создать, хотя и возвращает ссылку.

Надеюсь это поможет.

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

Это не очень хорошая практика кодирования для пользователя при ошибке.
Я бы порекомендовал вам просмотреть папки.
Затем, если определенное имя не найдено, создайте его.
Код ниже часть моего Макрос, который я использую.
Он ищет дубликаты в папке "Входящие".
Он намеренно не делает этого рекурсивно.

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

Медленный способ. Зависит от количества папок.

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

Быстрый способ. Добавить без проверки существующих папок.

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