MyTetra Share
Делитесь знаниями!
Проверьте, существует ли папка Outlook; если не создать его
Время создания: 16.03.2019 23:41
Текстовые метки: vba, vba_outlook
Раздел: Разные закладки - MSO - Outlook
Запись: xintrea/mytetra_db_adgaver_new/master/base/1552768802gyyqft92yf/text.html на raw.githubusercontent.com

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


Я пытаюсь проверить, существует ли папка; если он не создает его. Ниже приведена только ошибка времени выполнения.


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

 

Однако, если папка существует, то работает ниже ...

If myFolder.Folders("Close") > 0 Then

    MsgBox "Yay!"           

End If

 

Зачем? Что я могу сделать, чтобы исправить проблему?

Размещён: 18.11.2018 08:57

Ответы (2)


0 плюса

41704 Репутация автора

Во-первых, вы сравниваете результат 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

  subFolder = myFolder.Folders.Add("Close")

End If

 

Размещён: 19.11.2018 12:29

0 плюса

10140 Репутация автора

Я не понимаю: 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

 

 

 

 
MyTetra Share v.0.65
Яндекс индекс цитирования