Исходный текст

Option Explicit
Call TestMailFolders()


'==============================================================================
' Вывести информацию обо всех связях объекта
'==============================================================================
Sub TestMailFolders()
        
        Dim SelDlg, RetVal, strAction, ArActions, FCol
        
        Set FCol = ThisApplication.MailFolders
        ArActions = Array("Создать почтовую папку", "Удалить почтовую папку")
        
        'Предоставить пользователю выбрать действие 
        Set SelDlg = ThisApplication.Dialogs.SelectDlg
        SelDlg.SelectFrom = ArActions 
        SelDlg.Prompt = "Выберите действие:"
        RetVal = SelDlg.Show
        
        'Если пользователь отменил диалог или ничего не выбрал, закончить работу.
        'Диалог вернул массив, поскольку был инициализирован строковым массивом
        If (RetVal <> TRUE) Or (UBound(SelDlg.Objects)<0) Then Exit Sub
        
        'Выполнить все заданные действия
        For Each strAction In SelDlg.Objects
                If StrComp(strAction, ArActions(0))=0 Then
                                                                                    Call CreateFolder(FCol)
                ElseIf StrComp(strAction, ArActions(1))=0 Then
                                                                                    Call RemoveFolder(FCol)
                End If
        Next
        
                
End Sub
'==============================================================================


'==============================================================================
'Создать новую почтовую папку в ящике текущего пользователя
'==============================================================================
Sub CreateFolder(FCol)
        Dim MailFolderDlg, NewFolder
        
        'Создать новый объект TDMSMailFolder в коллекции
        Set NewFolder = FCol.Create
        'Присвоить описание
        NewFolder.Description = "Test"        
        NewFolder.SysName = "TEST_MAILFOLDER"
        'Открыть созданную папку в диалоге
        Set MailFolderDlg = ThisApplication.Dialogs.MailFolderDlg
        MailFolderDlg.Object = NewFolder
        MailFolderDlg.Show
        'В логах отладчика выводим идентификатор
        ThisApplication.DebugPrint("Идентификатор новой почтовой папки - " & NewFolder.Handle)
End Sub
'==============================================================================

'==============================================================================
'Удалить почтовую папку из приложения 
'==============================================================================
Sub RemoveFolder(FCol)
        Dim ArSize, ArFolders, fld, i, SelDlg, RetVal, bDelete
        
        'Заполнить массив ссылками на почтовые папки текущего пользователя
        ArSize = ThisApplication.MailFolders.Count
        ReDim ArFolders(ArSize)
        
        For i=0 To ArSize-1
                Set ArFolders(i) = ThisApplication.MailFolders(i)
        Next
        
        'Открыть диалог выбора, передав на вход массив ссылок
        Set SelDlg = ThisApplication.Dialogs.SelectDlg
        SelDlg.SelectFrom = ArFolders
        SelDlg.Caption = "Все почтовые папки пользователя"
        SelDlg.Prompt = "Выберите папку для удаления:"
        RetVal = SelDlg.Show
        
        'Проверить наличие тестовых почтовых папок среди удаляемых
        With SelectDlg.Objects
            For i = 0 to .Count - 1
                    if .Item(i).Description = "Test" Then
                        MsgBox ("Системное имя тестового папки для удаления - " & .Item(i).SysName)
                    End If
            Next
        End With
        
        
        'Если пользователь отменил диалог или ничего не выбрал, закончить работу.
        'Диалог вернул массив, поскольку был инициализирован массивом
        If (RetVal <> TRUE) Or (UBound(SelDlg.Objects)<0) Then Exit Sub
        
        'Отключить обработку ошибок (они могут возникнуть при удалении)
        On Error Resume Next
        
        'Собственно удаление перечисленных папок
        For Each fld In SelDlg.Objects
        
                'Если в папке есть сообщения, запросить подтверждение удаления
                bDelete = TRUE
                If fld.Messages.Count<>0 Then
                        bDelete = MsgBox("Папка содержит сообщения. Удалить в любом случае?", _
                                vbQuestion+vbYesNo)
                End If
        
                'Попытаться удалить указанную пользователем папку
                If bDelete Then
                        MsgBox ("Номер удаленной папки - " & Fcol.Index(fld))
                        FCol.Erase fld 
                        'Если ошибка была, возможно папка системная (предустановленная) 
                        If Err<>0 Then
                                MsgBox "Ошибка удаления папки """ & fld.Description & """." & Chr(13) &_
                                                "Код ошибки: " & Err, vbExclamation     
                        End If        
                        
                        'Обнулить ошибку
                        Err=0
                End If
        Next
        
End Sub
'==============================================================================