vba를 사용하여 Outlook의 다른 maibox에 액세스

Question

내 Outlook에는 두 개의 사서함이 있습니다.

하나는 내 것이고 자동으로 로그인하면 내 PC에 로그인하고 다른 메일은 반송 메일입니다.

정말 메일 계정의받은 편지함에 액세스해야하지만 그럴 수없는 것 같습니다.

는

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 

내가 얻고 문제에있다 :

그리고 내 기본 사서함 여기

로 메일 계정의 사서함을 만들 수있는 방법이없는 내가 지금까지 가지고있는 코드입니다 내가 해결 MSGBOX를 얻을

Set aFolder = ns.GetSharedDefaultFolder(myRecipient, olFolderInbox)

그래서 그 노력 알고 있지만 그 후 오류가 발생합니다 :

Run-Time Error

오류 자체에 대해서는별로 말하지 않습니다.

누구든지 나를 도와 줄 수 있습니까? 감사합니다

Answer 1

액세스하려는 폴더가 Exchange 폴더가 아닌 경우 Exchange 폴더 인 경우 찾을 필요가 있습니다. 네임 스페이스에 로그온하십시오. 이름 공간에

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