Fetching email addresses with email domain cell value - arrays

Question

I fetch email addresses from my Outlook account.
Now I am trying to fetch only specific email address from inbox e.g. Gmail.com that returns gmail addresses only.
I modified the code where I used array to store the addresses temporarily and then compare to string. After altering the code it returns nothing (not even errors).
Option Explicit
Sub GetInboxItems()
Dim ol As outlook.Application
Dim ns As outlook.Namespace
Dim fol As outlook.Folder
Dim I As Object
Dim mi As outlook.MailItem
Dim N As Long
Dim val As String
Dim MyArray() As String, MyString As String, J As Variant, K As Integer
Dim MyAs As Variant
Dim Awo As Variant
MyString = Worksheets("Inbox").Range("D1")
MyArray = Split(MyString, ";")
Application.ScreenUpdating = False
Set ol = New outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set fol = ns.GetDefaultFolder(olFolderInbox)
'Dim inputSheet As Worksheet
'Dim aCellOnInputSheet As Range
'Dim inputDateCell As Range
'Dim userSheetName As String
'Set cod = ThisWorkbook.Worksheets("Inbox")
'Set aCellOnInputSheet = cod.Range("D1")
'userSheetName = aCellOnInputSheet.Value
Range("A3", Range("A3").End(xlDown).End(xlToRight)).Clear
N = 2
For Each I In fol.Items
If I.Class = olMail Then
Set mi = I
N = N + 1
If mi.SenderEmailType = "EX" Then
MyAs = Array(mi.Sender.GetExchangeUser().PrimarySmtpAddress)
For Each Awo In MyAs
If InStr(MyString, Awo) > 0 Then
Cells(N, 1).Value = mi.Sender.GetExchangeUser().PrimarySmtpAddress
Cells(N, 2).Value = mi.SenderName
Exit For
End If
Next
' Cells(N, 1).Value = mi.Sender.GetExchangeUser().PrimarySmtpAddress
' Cells(N, 2).Value = mi.SenderName
Else
MyAs = Array(mi.SenderEmailAddress)
For Each Awo In MyAs
If InStr(MyString, Awo) > 0 Then
Cells(N, 1).Value = mi.SenderEmailAddress
Cells(N, 2).Value = mi.SenderName
Exit For
End If
Next
End If
End If
Next I
Application.ScreenUpdating = True
End Sub
Fetching all email addresses will be problematic. I don't want to expose any email domains other than the defined ones.

Answer 1

Minimal changes to manipulating the row n and switching the variables in Instr should be sufficient.
This also shows how to drop the array if one domain.
Option Explicit
Sub GetInboxItems_SingleDomain()
' Early binding - reference to Microsoft Outlook XX.X Object Library required
Dim ol As Outlook.Application
Dim ns As Outlook.Namespace
Dim fol As Outlook.Folder
Dim folItm As Object
Dim mi As Outlook.MailItem
Dim n As Long
Dim myString As String
Dim myAddress As String
myString = Worksheets("Inbox").Range("D1") ' gmail.com
'Debug.Print myString
Application.ScreenUpdating = False
Set ol = New Outlook.Application
Set ns = ol.GetNamespace("MAPI")
Set fol = ns.GetDefaultFolder(olFolderInbox)
Range("A3", Range("A3").End(xlDown).End(xlToRight)).Clear
n = 3
' If slow, limit the number of items in the loop
' e.g. https://stackoverflow.com/questions/21549938/vba-search-in-outlook
' strFilter = "#SQL=" & Chr(34) & "urn:schemas:httpmail:fromemail" & Chr(34) & " like '%" & myString & "'"
For Each folItm In fol.Items
If folItm.Class = olMail Then
Set mi = folItm
If mi.SenderEmailType = "EX" Then
myAddress = mi.Sender.GetExchangeUser().PrimarySmtpAddress
Else
myAddress = mi.SenderEmailAddress
End If
'Debug.Print myAddress
'The bigger text on the left
' In general, not necessarily here, keep in mind case sensitivity
If InStr(LCase(myAddress), LCase(myString)) > 0 Then
Cells(n, 1).Value = myAddress
Cells(n, 2).Value = mi.SenderName
n = n + 1
End If
End If
Next folItm
Application.ScreenUpdating = True
Debug.Print "Done."
End Sub