Question

我有一个宏，可帮助我根据Excel工作表中列出的电子邮件主题行列表从Outlook下载电子邮件附件。

下面是我要对此宏进行的更改。

•定义Outlook收件箱，实际上我希望宏搜索公共团队共享邮箱而不是个人邮箱

•从Excel单元格定义“另存为”文件夹路径，而不是对宏中的路径进行硬编码

•定义主题行唯一的部分而不是整个主题行，因为它由日期和每天更改的一些代码组成，因此我们不能对主题行进行硬编码

•下载附件后，电子邮件应标记为已读。

Sub Downloademailattachementsfromexcellist()Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String


Const num As Integer = 6
Const path As String = "C:\HP\" ' i want this to fetch the value from excel worksheet something like ThisWorkbook.Sheets("Email Download").Range("C1").value
Const olFolderInbox As Integer = 6 ' I want to define the common shared mailbox over here...instead of my own personal box. Common mailbox name is IGT Team


Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)


If olmail.items.restrict("[UNREAD]=True").Count = 0 Then


    MsgBox ("No Unread mails")


    Else


        For Each olitem In olmail.items.restrict("[UNREAD]=True")
            lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1


            Range("B" & lrow).Value = olitem.Subject ' each email subject line consists of date or some code which changes daily so I will just mention the unique part of the subject line which remains same daily.



            If olitem.attachments.Count <> 0 Then


                For Each olattach In olitem.attachments


                    olattach.SaveAsFile path & olattach.Filename
                    ' Once the attachement is downloaded I want the macro to mark the mail as Read


                Next olattach
            End If                


        Next olitem


End If
End Sub

下载Excel中列出的基于电子邮件附件的电子邮件主题行

0 个答案: