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常量。