VBA Outlook Email 附件保存权限

Question

该脚本假设循环通过我的 outlook 文件夹收件箱-> 工作请求然后为该文件夹中的每个邮件项目下载每个附件并将 if 保存到文件位置。

代码在查找文件夹和正确的电子邮件时似乎工作正常，但是它在以下代码行中给我一条错误消息，说“运行时错误'-2147024891（80070005）无法保存附件。你没有执行此操作的适当权限。”

我尝试了多个保存位置，包括我们的外部云驱动器和我的个人桌面。 目前代码正在保存到我的桌面，但仍然说我没有适当的保存权限。 任何帮助将不胜感激。

olAtt.SaveAsFile ("C:\Users\John Smith\Desktop\WOR Email Download")

脚本的 rest 如下所示。

Option Explicit


Sub Download_Outlook_Attachemtns()



Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim olItem As Object
Dim MailItem As Outlook.MailItem
Dim olAtt As Outlook.Attachment
Dim FileLocation As String

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")


'single folder link to hidden sheet folders([admin].[Mailbox].text)
Set olFolder = olNS.Folders("JohnSmith@work.com")
Set olFolder = olFolder.Folders("Inbox")
Set olFolder = olFolder.Folders("Work Requests")




For Each olItem In olFolder.Items

    If olItem.Class = olMail Then
        Set MailItem = olItem
            'Debug.Print MailItem.Subject



    For Each olAtt In MailItem.Attachments
        If MailItem.ReceivedTime > ThisWorkbook.Worksheets("Email_Info").Range("C6").Value Then
    
            olAtt.SaveAsFile ("C:\Users\John Smith\Desktop\WOR Email Download")
            'olAtt.SaveAs Filename:=Application.GetSaveAsFilename
        End If
    Next olAtt


     End If
Next olItem




'Set olFolder = Nothing
'Set olNS = Nothing


End Sub

Answer 1

除了文件夹名称之外，您还必须包含文件名称。 目前，您告诉 Outlook 保存到与现有文件夹名称冲突的文件（“WOR Email 下载”），因此出现“无法访问”错误 - 由于文件名称与现有文件夹名称冲突，因此无法创建文件。 将您的代码更改为

if olAtt.Type = olByValue Then
  olAtt.SaveAsFile "C:\Users\John Smith\Desktop\WOR Email Download\" & olAtt.FileName
End If

Answer 2

首先，而不是遍历文件夹中的所有项目：

For Each olItem In olFolder.Items

    If olItem.Class = olMail Then
        Set MailItem = olItem

您可以在文件夹中找到所有带有附件的项目并仅对其进行迭代。 Items class 的Find / FindNext或Restrict方法具有魔力。 在我为技术博客撰写的文章中阅读有关这些方法的更多信息：

• 如何：使用 Find 和 FindNext 方法从文件夹中检索 Outlook 邮件项目（C#、VB.NET）

• 如何：使用限制方法从文件夹中检索 Outlook 邮件项目

例如，您可以使用以下搜索条件（VBA 语法）：

Filter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:hasattachment" & Chr(34) & "=1"

通过更改条件的顺序来优化代码也是有意义的：

For Each olAtt In MailItem.Attachments
        If MailItem.ReceivedTime > ThisWorkbook.Worksheets("Email_Info").Range("C6").Value Then
    

您可以在遍历附件之前检查一次 email 的接收时间，而不是检查 email 的接收时间，或者更好的是，您可以通过在搜索字符串中使用逻辑 AND 运算符在搜索条件中包含另一个条件。

最后，您可以在尝试将任何内容保存到磁盘之前尝试检查Attachment.Type属性值。 该属性返回一个指示指定 object 类型的OlAttachmentType常量。