2009-03-11 8 views
3

私はOutlookに2つのメールボックスを持っています。vbaを使用してoutlook内の別のmaiboxにアクセスする

1つは私のもので、私のPCにログインすると自動的にログインし、もう1つはメールのバウンスのために自動的にログインします。

私は本当にメールのアカウントの受信トレイにアクセスする必要がありますが、私はそれを行うように見えません。

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("[email protected]") 
    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

エラーそのものについてはあまり言及していません。

誰でも私をここで助けてくれますか? ありがとう

答えて

3

アクセスしたいフォルダが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 
+1

wow!コードをありがとう。新しいプロファイルを作成し、私が欲しいアカウントだけを指定することで問題を解決できたので、コードはそのアカウントで実行されます:)ありがとう – AntonioCS

関連する問題