更新到Office 365后找不到默认收件箱

时间:2018-09-17 17:44:24

标签: vba outlook

我有用于在Outlook电子邮件中查找特定主题行并从电子邮件中获取附件的代码。

我们将电子邮件与公司收购合并在一起,并将Microsoft帐户更新到Office365。除此之外,我的原始VBA代码应该可以使用,因为它不查找任何特定的电子邮件文件夹。检查所有Outlook参考。

我对olMi一无所获,它退出了if语句。

Function Report()

Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim olFldr As MAPIFolder
Dim olItms As Items
Dim olMi As MailItem
Dim olEmail As Outlook.MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim wB As Workbook

Set olApp = GetObject(, "Outlook.Application")
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items
Set olEmail = olApp.CreateItem(olMailItem)

Set rng = Nothing

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

subj = "Scheduled Report - Instructor List"

Set olMi = olItms.Find("[Subject] = " & Chr(34) & subj & Chr(34))

''___> I get "OlMi = Nothing" here and it used to work
If Not (olMi Is Nothing) Then
    For Each olAtt In olMi.Attachments
        olAtt.SaveAsFile "C:\Users\Instructor\Desktop\temp\Instructor_Master.xls"
    Next olAtt
Else
End If
End Function

0 个答案:

没有答案