Outlook VBA snippets

E-mail en naam extraheren uit geëxporteerd .CSV-bestand van MailBox.

Sub readCSV()

    Dim strBestand As String
    Dim strRegel As String
    
    Dim objRegExEmail As Object
    Dim objRegExEmailNaam As Object
    Dim strEmail
    Dim strEmailNaam
    
'   Via regular expression e-mail en naam extraheren
    Set objRegExEmail = CreateObject("VBScript.RegExp")
    Set objRegExEmailNaam = CreateObject("VBScript.RegExp")
    
'   Regular expression patronen
    objRegExEmail.Pattern = "[A-Za-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-zA-Z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?"
    objRegExEmailNaam.Pattern = ":\s*(.*?)\s*[[<]"
    
'   Geexporteerd Outlook .csv-bestand inlezen
    strBestand = ThisWorkbook.Path & Application.PathSeparator & "bron.csv"
     
    Open strBestand For Input As #1
        Do
            Line Input #1, strRegel
            
            If InStr(1, strRegel, "@") And InStr(1, strRegel, "Van: ") Then
                
                Debug.Print "Regel: " & vbTab & strRegel
                
                If objRegExEmail.Test(strRegel) Then
'                   Standaardwaarde regular expression
                    Set strEmail = objRegExEmail.Execute(strRegel)
                    Debug.Print "E-mail: " & vbTab & strEmail(0).Value
                End If
                
                If objRegExEmailNaam.Test(strRegel) Then
'                   Groepswaarde (submatch) regular expression
                    Set strEmailNaam = objRegExEmailNaam.Execute(strRegel)
                    Debug.Print "Naam: " & vbTab & vbTab & strEmailNaam(0).Submatches.Item(0)
                End If
                
                Debug.Print vbNewLine
                
            End If
            
        Loop While Not EOF(1)

    Close #1
    
End Sub

alternatief: https://www.msoutlook.info/question/869

Twee events voor inlezen e-mail: 1. bij ontvangen (outInboxItems_ItemAdd) en 2. bij selecteren (outExplorer_SelectionChange).

Option Explicit

Private WithEvents outInboxItems As Outlook.Items
Public WithEvents outExplorer As Outlook.Explorer

Dim strID As String

Private Sub Application_Startup()

    Dim outNS As Outlook.NameSpace
    
    Set outNS = Application.GetNamespace("MAPI")

    Set outInboxItems = outNS.GetDefaultFolder(olFolderInbox).Items
    Set outExplorer = Application.ActiveExplorer

End Sub
 
Private Sub outExplorer_SelectionChange()
 
    readMail outExplorer.Selection.item(1)
   
End Sub

Private Sub outInboxItems_ItemAdd(ByVal item As Object)
    
    readMail item

End Sub

Sub readMail(item As Object)

'   ########################################
'   ter voorkoming van meerdere aanroepingen
    
    If strID = item.EntryID Then Exit Sub
    strID = item.EntryID
    
'   ########################################
    
    If TypeName(item) = "MailItem" Then
        MsgBox "Afzender: " & item.SenderEmailAddress & vbCrLf & _
            "Namens: " & item.SentOn & vbCrLf & _
            "Ontvangen: " & item.ReceivedTime & vbCrLf & _
            "Onderwerp: " & item.Subject & vbCrLf & _
            "Grootte: " & item.Size & vbCrLf & _
            "Bericht: " & vbCrLf & item.Body
    End If

End Sub