僅獲取具有輸入單元格值電子郵件域的特定Outlook電子郵件地址

所以顯然我正在從我的 Outlook 帳戶中獲取 Outlook 電子郵件，我
能夠獲取所有電子郵件地址，現在我試圖從收件箱中僅獲取特定的電子郵件地址，例如。僅回傳 gmail 地址的 Gmail.com。
我修改了使用陣列臨時存盤地址然后與字串比較的代碼。但是在更改代碼后它什么也不回傳（甚至沒有錯誤）。PS。我是VBA的初學者。

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

獲取所有郵件將是有問題的，因為我想確保我不公開除定義的郵件域之外的任何郵件域。

uj5u.com熱心網友回復：

對操作第 n 行和切換變數進行最小的更改就Instr足夠了。

這也顯示了如何洗掉一個域的陣列。

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

標籤：数组 擅长 vba 电子邮件 外表

上一篇：電子郵件屏蔽正則運算式Kotlin

下一篇：如果我在邊車外部單擊，如何關閉邊車