【发布时间】:2019-12-12 12:09:13
【问题描述】:
我有一个代码:
- 转到共享邮箱 (Inquiry@company.com) 下方的特定文件夹(“公司 A 状态报告”)。
- 搜索未读邮件 + 主题词组:“A 公司状态报告”
- 接收符合条件的电子邮件,找到最后一封电子邮件,然后检查附件是否存在。
- 如果存在附件,则下载文件。
该代码以前可以运行,但现在我在此行出现错误:
Set olFolder = oOlns.GetSharedDefaultFolder(olShareName, olFolderInbox) '// Inbox
错误是:
"不允许赋值给常量"
Option Explicit
Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "C:\Projects\Attachments"
Sub DownloadAttachmentFirstUnreadEmail()
Dim oOlInbFiltered As Variant
Dim oOlAp As Object, oOlns As Object, oOlInb As Object
Dim oOlItm As Object, oOlItmF As Object, oOlAtch As Object
'~~> New File Name for the attachment
Dim NewFileName As String
NewFileName = AttachmentPath & Format(Date, "DD-MM-YYYY") & " - "
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
'Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox).Folders("Company A status report") 'If outlook only contain the following:
'Looks in Inbox
'-Personal Inbox
'-Company A status report
Dim olShareName As Object
'https://superuser.com/questions/1035062/how-to-run-a-macro-on-a-shared-mailbox-in-outlook-2013
Set olShareName = oOlns.CreateRecipient("Inquiry@company.com") '// Owner's email address
Set olFolder = oOlns.GetSharedDefaultFolder(olShareName, olFolderInbox) '// Inbox
Set oOlInb = olFolder.Folders("Company A status report")
'Looks in Shared Inbox
'-Personal Inbox
'-Inquiry Inbox (Shared)
'-Company A status report
'~~> Check if there are any actual unread emails
If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
MsgBox "NO Unread Email In Inbox"
Exit Sub
End If
'https://stackoverflow.com/questions/30464271/find-an-email-starting-with-specific-subject-using-vba
'~~> Filter all unread mails with the subject: Company A status report
Dim Findvariable As String
Findvariable = "Company A status report"
Dim filterStr As String
filterStr = "@SQL=" & "urn:schemas:httpmail:subject like '%" & Findvariable & "%'"
Set oOlInbFiltered = oOlInb.Items.Restrict(filterStr)
Set oOlInbFiltered = oOlInb.Items.Restrict("[UnRead] = True")
'Set oOlInbFiltered = oOlInb.Items.Restrict("[UnRead] = True AND [Subject] = 'Company A status report'") - works
'Test how many mails that are found and populated in the variable: oOlInbFiltered
MsgBox ("Hello Test")
Dim testp As Object
For Each testp In oOlInbFiltered
Debug.Print testp.Subject
Next testp
'Sort all the mails by ReceivedTime so the loop will start with the latest mail
oOlInbFiltered.Sort "ReceivedTime", True 'True for Ascending. Take the last mail to the oldest. We only want the last and therefore exit the loop after we find it.
For Each oOlItm In oOlInbFiltered
'Debug.Print oOlItm
'~~> Check if the email actually has an attachment
If oOlItm.Attachments.Count <> 0 Then
For Each oOlAtch In oOlItm.Attachments
Debug.Print oOlAtch
'~~> Download the attachment
oOlAtch.SaveAsFile NewFileName & oOlAtch.FileName
'Mark the found mail as read
oOlItm.UnRead = False
DoEvents
oOlItm.Save
Exit For
Next
Else
MsgBox "The Email doesn't have an attachment"
End If
Exit For
Next oOlItm
'Open the downloaded file
Dim wb As Workbook
Dim FilePath As String
FilePath = NewFileName & oOlAtch.FileName
Set wb = Workbooks.Open(FilePath)
'Set DataPage = wb1.Sheets("DATA")
End Sub
【问题讨论】:
-
缺少
olFolder的声明表示缺少Option Explicit(甚至您的代码也包含它)。删除 Outlook 参考,因为您的代码看起来与 Outlook 绑定得很晚。当您将olFolderInbox定义为常量时,这可能会导致错误,什么是 Outlook 枚举(如果后期绑定则无法访问)。 -
这段代码看起来很熟悉 ;) 如果你在
Set olFolder = oOlns.GetSharedDefaultFolder(olShareName, olFolderInbox)之前输入这两行olShareName.Resolve和If Not olShareName.Resolved Then Msgbox "Unable To resolve"会发生什么 -
是的,它原本是你的,稍加修改。谢谢它真的很好用,对我有很大帮助!!不幸的是,你的建议仍然让我在同一行出现同样的错误。
-
解决方案是调暗导致错误的对象。所以我在错误行
Set olFolder ...之前添加了:Dim olFolder As Outlook.Folder -
为什么要提前绑定(
Dim olFolder As Outlook.Folder) ,当一切都准备好后期绑定(Dim olFolder As Object) (兼容不同的Outlook版本,如果是早期版本,只支持相同或更新的版本)