Загрузка почтовых вложений на основе строк темы электронной почты, перечисленных в Excel

Question

У меня есть макрос, который помогает мне загружать вложения электронной почты из Outlook на основе списка строк темы электронной почты, перечисленных в листе Excel.

Ниже приведены изменения, которые я хочу внести в этот макрос.

• Определите папку «Входящие» 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