Доступ к другому Maibox в Outlook с помощью VBA

Question

У меня есть два почтовых ящика в моем Outlook.

Тот, который принадлежит мне, и он автоматически регистрирует меня при входе на компьютер, а другой, который у меня есть, предназначен для отказов почты.

Мне действительно нужен доступ к почтовому ящику почтового ящика, но я просто не могу этого сделать.

И я никак не могу сделать почтовый ящик почтовой учетной записи моим почтовым ящиком по умолчанию

Вот код, который у меня есть:

Public Sub GetMails()

    Dim ns As NameSpace
    Dim myRecipient As Outlook.Recipient
    Dim aFolder As Outlook.Folders

    Set ns = GetNamespace("MAPI")

    Set myRecipient = ns.CreateRecipient("mail@mail.pt")
    myRecipient.Resolve
    If myRecipient.Resolved Then
        MsgBox ("Resolved")
        Set aFolder = ns.GetSharedDefaultFolder(myRecipient, olFolderInbox)
    Else
        MsgBox ("Failed")
    End If

End Sub

Проблема, которую я получаю, заключается в

Set aFolder = ns.GetSharedDefaultFolder(myRecipient, olFolderInbox)

Я получаю сообщение Resolved msgbox, поэтому я знаю, что оно работает, но после этого я получаю сообщение об ошибке:

Ошибка времени выполнения

, который мало говорит о самой ошибке.

Может кто-нибудь помочь мне здесь, пожалуйста? Спасибо

Answer 1

Если папка, к которой вы хотите получить доступ, не является папкой Exchange, вам нужно будет найти ее, если это папка Exchange, попробуйте войти в пространство имен.

Войдите в NameSpace

  Set oNS = oApp.GetNamespace("MAPI")
  oNS.Logon

Найти папку Насколько я помню, этот код от Сью Мошер.

Public Function GetFolder(strFolderPath As String) As Object 'MAPIFolder
' strFolderPath needs to be something like
'   "Public Folders\All Public Folders\Company\Sales" or
'   "Personal Folders\Inbox\My Folder" ''

Dim apOL As Object 'Outlook.Application '
Dim objNS As Object 'Outlook.NameSpace '
Dim colFolders As Object 'Outlook.Folders '
Dim objFolder As Object 'Outlook.MAPIFolder '
Dim arrFolders() As String
Dim I As Long

On Error GoTo TrapError

    strFolderPath = Replace(strFolderPath, "/", "\") 
    arrFolders() = Split(strFolderPath, "\")

    Set apOL = CreateObject("Outlook.Application")
    Set objNS = apOL.GetNamespace("MAPI")


    On Error Resume Next

    Set objFolder = objNS.Folders.Item(arrFolders(0))

    If Not objFolder Is Nothing Then
        For I = 1 To UBound(arrFolders)
            Set colFolders = objFolder.Folders
            Set objFolder = Nothing
            Set objFolder = colFolders.Item(arrFolders(I))

            If objFolder Is Nothing Then
                Exit For
            End If
        Next
    End If

    Set GetFolder = objFolder
    Set colFolders = Nothing
    Set objNS = Nothing
    Set apOL = Nothing


End Function