Retrieve e-mail body content depending on subject title and cell value. Range not working for cell value

Question

I want to retrieve the content of an email with a certain subject which is linked to a cell value in a different column.

A similar thread was made but I'm not sure if I could ask additional questions in that thread or create a new one, my apologies. Similar thread: If Outlook Subject and Date Received

Code from this thread works perfect with the exception of range. Instead of 1 cell value (ex. A1) I want to retrieve it from the full column A. So that for each value in column A (which is in this case the date) the content of the e-mail which contains as subject "always the same title" & "date of cells in column A".

ex. A1 = 16/08/2019 ==> e-mail subject = 16/08Title ==> B2 = content of said e-mail A2 = 20/08/2019 ==> e-mail subject = 20/08Title ==> B2 = content of said e-mail

Sub GetFromInbox ()

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant 
Dim i As Long

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = OlFldr.Items

olItms.Sort "Subject"
i =1

For Each olMail In olItms
  If InStr (1, olMail.Subject, "Subject" & Range ("A1") > 0 Then 
     ThisWorkbook.Sheets("Sheet1").Cells(i,2).Value = olMail.Body
     i = i + 1

  End If
  Next olMail

 Set olFldr = Nothing
 Set olNs = Nothing
 Set olApp = Nothing

 End Sub

I have tried changing Range ("A1") to range ("A:A"). But this gives a runtime error 13: Type mismatch . I have also tried to use different ways to offset. I'm not very skilled yet in VBA and I haven't found the solution in my online search. Thank you in advance for helping!

Sub GetFromInbox ()

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant 
Dim i As Long

Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = OlFldr.Items

olItms.Sort "Subject"
i =1

For Each olMail In olItms
  If InStr (1, olMail.Subject, "Subject" & Range ("A1") > 0 Then 
     ThisWorkbook.Sheets("Sheet1").Cells(i,2).Value = olMail.Body
     i = i + 1

  End If
  Next olMail

 Set olFldr = Nothing
 Set olNs = Nothing
 Set olApp = Nothing

 End Sub

Answer 1

Create a for loop that will loop through all of the rows of column A.

LastRow = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 
'Finding the last row in Column A    
For Each olMail In olItms
    For j = 1 To LastRow
      If InStr (1, olMail.Subject, "Subject" & Range ("A" & j) > 0 Then 
         ThisWorkbook.Sheets("Sheet1").Cells(i,2).Value = olMail.Body
         i = i + 1
      End If
    Next j
Next olMail