Frankly your code doesn't make much sense. You have selected a path from a fixed cell in the worksheet when if this is correct you could hard code the path without reference to the sheet, and you are comparing the subject with the empty row after the last row in column A, i.e. Row + 1, so that's never going to achieve anything if there are fewer rows in column B. So get instead the last row in the column you are referencing.
It is also not clear whether the path will exist, so you need to add code to check and if necessary add the path. The shared path will depend on how your system is configured, but I have included code that might work for you.
The code will extract all attachments and that includes images in the message including in the signature, and the code will overwrite any existing attachment of the same name in the folder.
Also I strongly recommend using the function linked from the top of the code rather than create a new Outlook instance.
Given those provisos try the following.
Option Explicit
'++++++ Important ++++++
'Graham Mayor - https://www.gmayor.com - Last updated - 16 Apr 2019
'Use the code from http://www.rondebruin.nl/win/s1/outlook/openclose.htm
'to start Outlook
'+++++++++++++++++++++++
Sub Downloademailattachementsfromexcellist()
Dim olApp As Object
Dim olNS As Object
Dim olItem As Object
Dim olRecip As Object
Dim olShareInbox As Object
Dim lRow As Integer
Dim olAttach As Object
Dim strPath As String
Dim strName As String
Dim xlSheet As Worksheet
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 olApp = OutlookApp()
Set olNS = olApp.GetNameSpace("MAPI")
'The following two lines should get the shared folder, but without access to your setup I cannot test it
'Set olRecip = olNS.CreateRecipient(olNS.CurrentUser.Address) ' Owner's Name or email address
'Set olShareInbox = olNS.GetSharedDefaultFolder(olRecip, olFolderInbox)
'so I have used the default inbox for testing
Set olShareInbox = olNS.GetDefaultFolder(olFolderInbox)
'-----------------------
Set xlSheet = ActiveWorkbook.Sheets("Email Download")
strPath = "C:\HP\" & xlSheet.Range("C1").value & "\"
If olShareInbox.Items.restrict("[UNREAD]=True").Count = 0 Then
MsgBox ("No Unread mails")
Else
CreateFolders strPath 'ensure the save path is present
For Each olItem In olShareInbox.Items.restrict("[UNREAD]=True")
lRow = xlSheet.Range("A" & xlSheet.Rows.Count).End(xlUp).Row ' + 1
If InStr(1, olItem.Subject, xlSheet.Range("B" & lRow).value) > 0 Then ' 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
strName = olAttach.FileName
olAttach.SaveAsFile strPath & strName
olItem.UnRead = False ' Once the attachment is downloaded I want the macro to mark the mail as Read
Next olAttach
End If
End If
Next olItem
End If
End Sub
Private Sub CreateFolders(strPath As String)
Dim oFSO As Object
Dim lng_PathSep As Long
Dim lng_PS As Long
If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
lng_PathSep = InStr(3, strPath, "\")
If lng_PathSep = 0 Then GoTo lbl_Exit
Set oFSO = CreateObject("Scripting.FileSystemObject")
Do
lng_PS = lng_PathSep
lng_PathSep = InStr(lng_PS + 1, strPath, "\")
If lng_PathSep = 0 Then Exit Do
If Len(Dir(Left(strPath, lng_PathSep), vbDirectory)) = 0 Then Exit Do
Loop
Do Until lng_PathSep = 0
If Not oFSO.FolderExists(Left(strPath, lng_PathSep)) Then
oFSO.CreateFolder Left(strPath, lng_PathSep)
End If
lng_PS = lng_PathSep
lng_PathSep = InStr(lng_PS + 1, strPath, "\")
Loop
lbl_Exit:
Set oFSO = Nothing
Exit Sub
End Sub