繁体   English   中英

Outlook 365 Group vba 循环浏览电子邮件并保存附件

[英]Outlook 365 Group vba loop through emails and save attachment

我是名为“报告”的 Outlook 365 组的成员(并设置为所有者之一)。 每天“报告”都会收到带有附件 (xls/csv) 的电子邮件。 在我的 Outlook 应用程序中,我可以看到以下电子邮件:组 > 报告。 我希望 VBA 代码遍历“报告”的所有未读电子邮件,将附件保存在我的计算机上并将电子邮件设置为已读。 我已经为其他 Outlook 文件夹这样做了,这很完美。 我只是无法使用 VBA 访问 Outlook 365 组。 我在网上搜索了一段时间的答案,但找不到解决方案。 非常感谢您的帮助。 您可以在下面找到我的代码(我每天使用)来阅读文件夹 AUTO_REPORT_NWP 中的电子邮件

Sub Save_UnReadFiles_Auto_Report_NWP()
Dim O_App As Outlook.Application
Dim O_Space As Outlook.NameSpace 
Dim O_Folder As Outlook.MAPIFolder
Dim O_Mail As Outlook.MailItem
Dim O_Att As Outlook.Attachment
'-----------------------------------------------------------------------------
Const AutoReport_Folder As String = "A:\2022\Werk\AUTO_REPORT_NWP"
'-----------------------------------------------------------------------------
Dim strFilter As String
Dim TTDate As Date
Dim strFilePath As String
Dim strFileName As String
Dim MailID() As String, i As Integer, ii As Integer
'-----------------------------------------------------------------------------
Const MailSubject_WAE_1 As String = "WD-WAE_1_email"
Const MailSubject_WAE_2 As String = "WD-WAE_2_email"
Const MailSubject_WAE_3 As String = "WD-WAE_3_email"
Const MailSubject_WAE_4 As String = "WD-WAE_4_email"
Const MailSubject_WAE_5 As String = "WD-WAE_5_email"
'-----------------------------------------------------------------------------
    Set O_App = CreateObject("Outlook.Application")
    Set O_Space = O_App.GetNamespace("MAPI")
    Set O_Folder = O_Space.Folders("AUTO_REPORT_NWP")
    Set O_Folder = O_Folder.Folders("Inbox")
    i = 0
    strFilter = "[UNREAD]=TRUE"
    For Each O_Mail In O_Folder.Items.Restrict(strFilter)
        TTDate = O_Mail.ReceivedTime - 1
        strFilePath = AutoReport_Folder & "\" & Format(TTDate, "mm") & ". " & Format(TTDate, "mmmm") & "\"
        strFilePath = strFilePath & Format(TTDate, "dd") & Format(TTDate, "mm") & Format(TTDate, "yy")
        strFileName = ""
        Select Case O_Mail.Subject
            Case MailSubject_WAE_1
                strFileName = "WD-WAE_1.csv"
            Case MailSubject_WAE_2
                strFileName = "WD-WAE_2.csv"
            Case MailSubject_WAE_3
                strFileName = "WD-WAE_3.csv"
            Case MailSubject_WAE_4
                strFileName = "WD-WAE_4.csv"
            Case MailSubject_WAE_5
                strFileName = "WD-WAE_5.csv"
        End Select
        If strFileName <> "" Then
            i = i + 1
            For Each O_Att In O_Mail.Attachments
                If strFileName = "keep_original_name" Then
                    On Error Resume Next
                    O_Att.SaveAsFile strFilePath & "\" & O_Att.FileName
                Else
                    On Error Resume Next
                    O_Att.SaveAsFile strFilePath & "\" & strFileName
                End If
            Next
            ReDim Preserve MailID(1 To i)
            MailID(i) = O_Mail.EntryID
        End If
    Next
    If i <> 0 Then
        For ii = 1 To UBound(MailID)
            Set O_Mail = O_Space.GetItemFromID(MailID(ii))
            O_Mail.UnRead = False
            Set O_Mail = Nothing
        Next
    End If
    Set O_Folder = Nothing
    Set O_Space = Nothing
    Set O_App = Nothing
End Sub

组不作为存储公开 - 既不在扩展 MAPI 中的MAPISession::GetMsgStoresTable中,也不在 Outlook 对象模型中的Namespace.FoldersNamespace.Stores集合中。 只有通过Application.ActiveExplorer.CurrentFolder在 Outlook 中选择其中一个文件夹时,才能访问这些文件夹之一。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM