Вернуть тип Outlook MAPIFolder с помощью Excel VBA

Question

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

Private Sub addOutlookFolderIfNotExists()
     Set apOutlook = CreateObject("Outlook.Application")
     apOutlook.Session.Logon
     Dim myNameSpace As Outlook.Namespace
     Dim myFolder As Outlook.Folder
     Dim myNewFolder As Outlook.Folder

     Set myNameSpace = apOutlook.GetNamespace("MAPI")
     Set myFolder = 
    myNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders("Estimates")
     For i = 1 To myFolder.Folders.Count
        If myFolder.Folders.Item(i).Name = "Testing" Then
           Exit Sub
        End If
     Next

     addOutlookFolderIfNotExists = myFolder.Folders.Add("Testing")
End Sub

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

Private Function addOutlookFolderIfNotExists() As MAPIFolder
    Set apOutlook = CreateObject("Outlook.Application")
    apOutlook.Session.Logon
    Dim myNameSpace As Outlook.Namespace
    Dim myFolder As Outlook.Folder
    Dim myNewFolder As Outlook.Folder

    Set myNameSpace = apOutlook.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders("Estimates")
    For i = 1 To myFolder.Folders.Count
        If myFolder.Folders.Item(i).Name = "Testing" Then
            'Debug.Print TypeName(myFolder.Folders.Item(i))
            addOutlookFolderIfNotExists = myFolder.Folders.Item(i)
            Exit Function
        End If
    Next

    addOutlookFolderIfNotExists = myFolder.Folders.Add("Testing")
End Function 

Возвращает ошибку

переменная объекта vba или переменная блока не установлена ​​

, но я не знаю, к чему она относится.

Answer 1

Вы делаете это неправильно.Даже цикл For неверен.Правильный способ установить или назначить объект - использовать команду SET

. Это то, что вы пытаетесь?

Private Function addOutlookFolderIfNotExists() As MAPIFolder
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.Folder
    Dim myNewFolder As Outlook.Folder
    Dim i As Long

    Set apOutlook = CreateObject("Outlook.Application")

    apOutlook.Session.Logon

    Set myNameSpace = apOutlook.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders("Estimates")

    For i = 1 To myFolder.Folders.Count
        If myFolder.Folders.Item(i).Name = "Testing" Then
            '~~> Set the folder
            Set addOutlookFolderIfNotExists = myFolder.Folders.Item("Testing")
            Exit Function
        End If
    Next

    '~~> Create the folder
    myFolder.Folders.Add ("Testing")

    '~~> Set the folder
    Set addOutlookFolderIfNotExists = myFolder.Folders.Item("Testing")
End Function

Вы также можете сделать выше без ForLoop.Мы будем использовать On Error Resume Next вместо этого.

Private Function addOutlookFolderIfNotExists() As MAPIFolder
    Dim myNameSpace As Outlook.NameSpace
    Dim myFolder As Outlook.Folder
    Dim myNewFolder As Outlook.Folder
    Dim i As Long

    Set apOutlook = CreateObject("Outlook.Application")

    apOutlook.Session.Logon

    Set myNameSpace = apOutlook.GetNamespace("MAPI")
    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox).Parent.Folders("Estimates")

    '~~> Create the folder if it doesn't exists
    '~~> If it exists then suppress the error message and continue
    On Error Resume Next
    myFolder.Folders.Add ("Testing")
    On Error GoTo 0

    '~~> Set the folder
    Set addOutlookFolderIfNotExists = myFolder.Folders.Item("Testing")
End Function