从未读邮件中下载附件并来自特定发件人
Download attachments from From UnRead Items and are from specific sender
我想下载来自 MS Outlook 中特定发件人的未读和收到的电子邮件中的所有附件。
我找到了一个代码,可以从所有未读邮件中下载所有附件。
Downloading Attachments from Unread Emails of MS Outlook 并尝试对其进行调整。
但是,过滤器无法正常工作。显示没有这样的邮件。
Filter = "[Unread] = True And [SenderEmailAddress] = 'yrybchuk@gmail.com'"
完整代码如下:
Option Explicit
Public Sub Example()
Dim oOlAp As Object
Dim olNs As Outlook.Namespace
Dim Inbox As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Item As Outlook.MailItem
Dim Atmt As Attachment
Dim Filter As String
Dim FilePath As String
Dim AtmtName As String
Dim i As Long
'// Set Inbox Reference
Set oOlAp = GetObject(, "Outlook.application")
Set olNs = oOlAp.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
FilePath = "C:\Users\irybchuk\Documents\"
Filter = "[Unread] = True And [SenderEmailAddress] = 'yrybchuk@gmail.com'"
Set Items = Inbox.Items.Restrict(Filter)
'// Loop through backwards
For i = Items.Count To 1 Step -1
Set Item = Items.Item(i)
DoEvents
If Item.Class = olMail Then
Debug.Print Item.Subject ' Immediate Window
For Each Atmt In Item.Attachments
AtmtName = FilePath & Atmt.FileName
Atmt.SaveAsFile AtmtName
Next
End If
Next
Set Inbox = Nothing
Set Items = Nothing
Set Item = Nothing
Set Atmt = Nothing
Set olNs = Nothing
End Sub
我相信这里: 可以描述如何更改过滤线的可能解决方案。但是,我做不到。
你的过滤器似乎对我有用,但这里有一个不同的SQL DASL syntax你可以使用
Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & _
Chr(34) & " Like '%yrybchuk@gmail.com%' AND " & _
Chr(34) & "urn:schemas:httpmail:read" & _
Chr(34) & "=0"
或者更好的是带有附件 Restricted Filter 以改进循环
Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & _
Chr(34) & " Like '%yrybchuk@gmail.com%' AND " & _
Chr(34) & "urn:schemas:httpmail:hasattachment" & _
Chr(34) & "=1 AND " & _
Chr(34) & "urn:schemas:httpmail:read" & _
Chr(34) & "=0"
记得更新%yrybchuk@gmail.com%
FYI
If code is being run from Outlook then you don't need
oOlAp = GetObject(, "Outlook.application")
我想下载来自 MS Outlook 中特定发件人的未读和收到的电子邮件中的所有附件。
我找到了一个代码,可以从所有未读邮件中下载所有附件。 Downloading Attachments from Unread Emails of MS Outlook 并尝试对其进行调整。
但是,过滤器无法正常工作。显示没有这样的邮件。
Filter = "[Unread] = True And [SenderEmailAddress] = 'yrybchuk@gmail.com'"
完整代码如下:
Option Explicit
Public Sub Example()
Dim oOlAp As Object
Dim olNs As Outlook.Namespace
Dim Inbox As Outlook.MAPIFolder
Dim Items As Outlook.Items
Dim Item As Outlook.MailItem
Dim Atmt As Attachment
Dim Filter As String
Dim FilePath As String
Dim AtmtName As String
Dim i As Long
'// Set Inbox Reference
Set oOlAp = GetObject(, "Outlook.application")
Set olNs = oOlAp.GetNamespace("MAPI")
Set Inbox = olNs.GetDefaultFolder(olFolderInbox)
FilePath = "C:\Users\irybchuk\Documents\"
Filter = "[Unread] = True And [SenderEmailAddress] = 'yrybchuk@gmail.com'"
Set Items = Inbox.Items.Restrict(Filter)
'// Loop through backwards
For i = Items.Count To 1 Step -1
Set Item = Items.Item(i)
DoEvents
If Item.Class = olMail Then
Debug.Print Item.Subject ' Immediate Window
For Each Atmt In Item.Attachments
AtmtName = FilePath & Atmt.FileName
Atmt.SaveAsFile AtmtName
Next
End If
Next
Set Inbox = Nothing
Set Items = Nothing
Set Item = Nothing
Set Atmt = Nothing
Set olNs = Nothing
End Sub
我相信这里:
你的过滤器似乎对我有用,但这里有一个不同的SQL DASL syntax你可以使用
Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & _
Chr(34) & " Like '%yrybchuk@gmail.com%' AND " & _
Chr(34) & "urn:schemas:httpmail:read" & _
Chr(34) & "=0"
或者更好的是带有附件 Restricted Filter 以改进循环
Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:fromname" & _
Chr(34) & " Like '%yrybchuk@gmail.com%' AND " & _
Chr(34) & "urn:schemas:httpmail:hasattachment" & _
Chr(34) & "=1 AND " & _
Chr(34) & "urn:schemas:httpmail:read" & _
Chr(34) & "=0"
记得更新%yrybchuk@gmail.com%
FYI
If code is being run from Outlook then you don't need
oOlAp = GetObject(, "Outlook.application")