将引用引用到Excel VBA中的Outlook 365文件夹

Question

我的公司正在从Outlook 16转移到Outlook 365，而下面的Excel VBA脚本现在需要参考Outlook 365中的邮箱。

该行上的错误

Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")

带有错误

未遂操作失败。找不到对象。

是否需要以不同的方式添加邮箱？或者有其他方法可以在Outlook 365中执行此功能？

我没有以其他方式看到Outlook 365。

Sub Import_Email_Preferences()
    Const strMail As String = "[e-mail]"
    Dim oApp As Outlook.Application
    Dim oMapi As Outlook.MAPIFolder
    Dim oMail As Outlook.MailItem
    Dim strEmailAddress As String
    Dim strSenderName As String
    Dim strSubject As String
    Dim intRow As Integer
    Dim i As Long
    Dim tbl As ListObject
    Dim ltblRow As Long
    Set tbl = ThisWorkbook.Worksheets("Preferences").ListObjects(1)
    ltblRow = tbl.DataBodyRange.Rows.Count
    On Error Resume Next
    Set oApp = GetObject(, "OUTLOOK.APPLICATION")
        If (oApp Is Nothing) Then Set oApp = CreateObject("OUTLOOK.APPLICATION")
    On Error GoTo 0
    'Getting Error Here
    Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")
    For i = oMapi.Items.Count To 1 Step -1
        Set oMail = oMapi.Items(i)
        If TypeOf oMail Is Outlook.MailItem Then
            MsgBox = "Blue"
        End If
    Next i
    Set oApp = Nothing
    Set oMapi = Nothing
    Set oMail = Nothing
    Set oHTML = Nothing
    Set oElColl = Nothing
End Sub

Answer 1

请尝试通过GetDefaultFolder参考收件箱：

On Error Resume Next
If oApp Is Nothing Then
    Set oApp = GetObject(, "Outlook.Application")
    If oApp Is Nothing Then
        Set oApp = New Outlook.Application
    End If
End If
On Error GoTo 0
Set oMapi = oApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)

---

如果默认文件夹不可访问，请注意文件夹名称是依赖语言的，e。G。Namespace.Folders("Posteingang")在德语中。

Answer 2

Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")的麻烦是您将引用串在一起。如果有效的话，这很好，但是您不知道如果没有失败。

Set oMapi = oApp.GetNamespace("MAPI")如果oApp不是对象。

Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail)如果oApp.GetNamespace("MAPI")不是对象。

Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")如果oApp.GetNamespace("MAPI").Folders(strMail)不是对象。

我建议尝试下面的子例程以确定哪个步骤正在失败。该子例程以单个步骤完成所有操作。它还尝试不同的方法来实现相同的效果。如果一个Set失败，请评论并查看下一个是否有效。

我提出了一些失败的可能原因，但我敢肯定还有其他可能性。一旦知道失败的步骤，请回来，如果您需要进一步的帮助。

您可能还希望尝试ASGER建议GetDefaultFolder。它在我的系统上不起作用，因为未使用的默认收件箱。我必须命名包含我希望访问的收件箱的商店。

Sub TestGetInbox()
  Dim olApp As Outlook.Application
  Dim olInbox1 As Outlook.MAPIFolder
  Dim olInbox2 As Outlook.Folder
  Dim olInbox3 As Outlook.MAPIFolder
  Dim olInbox4 As Outlook.Folder
  Dim olNs As Outlook.Namespace
  Dim olSession As Outlook.Namespace
  Dim olStore1 As Outlook.Folder
  Dim olStore2 As Outlook.Folder
  ' If execution stops her, you have a problem accessing Outlook
  Set olApp = CreateObject("Outlook.Application")
  ' If execution stops here, you have a problem accessing Outlook's namespace
  ' using this method. Comment out statements down to  "Set olSession = olApp.Session"
  Set olNs = olApp.GetNamespace("MAPI")
  ' If execution stops here, look at your folder pane.  Is "[e-mail]"
  ' the name of a store? Case does not seem to matter but a single letter change in the name
  ' does.
  Set olStore1 = olNs.Folders("[e-mail]")
  Debug.Print olStore1.Name
  Set olInbox1 = olStore1.Folders("Inbox")
  Debug.Print olInbox1.Name
  Set olInbox2 = olStore1.Folders("Inbox")
  Debug.Print olInbox1.Name
  ' If execution stops her, you have a problem accessing Outlook's namespace
  ' This is a different methods of accessing Outlook's namespace.  The documentation
  ' says the two method are identical but I once had the olApp.Namespace("MAPI")
  ' fail so I now always use the olApp.Session method which has never failed for me.
  Set olSession = olApp.Session
  Set olStore2 = olSession.Folders("[e-mail]")
  Debug.Print olStore2.Name
  Set olInbox3 = olStore1.Folders("Inbox")
  Debug.Print olInbox1.Name
  Set olInbox4 = olStore1.Folders("Inbox")
  Debug.Print olInbox1.Name
  Set olInbox1 = Nothing
  Set olInbox2 = Nothing
  Set olStore1 = Nothing
  Set olNs = Nothing
  Set olInbox3 = Nothing
  Set olInbox4 = Nothing
  Set olStore2 = Nothing
  Set olSession = Nothing
  Set olApp = Nothing
End Sub