סקריפט לחילוץ כתובות מיילים

[ראש פינה]

נאבד לי רשימת תפוצה של עסק
אני מחפש סקריפט או תוכנה
שיחלץ לי לטבלת אקסל את כל הכתובות מייל ששלחתי להם אי פעם מייל.
המייל שייך לאאוטלוק ויש שם מלא מיילים....
ובסופו של דבר יהיה לי טבלת אקסל שיהיה שם, שם (אם קיים) ומייל.
איך מתחילים מה עושים? אשמח לכל עזרה.

[יהודי טוב]

@ראש-פינה

Sub ExportSentEmailsToExcel()
    Dim objNamespace As Outlook.Namespace
    Dim objFolder As Outlook.Folder
    Dim objItem As Object
    Dim objMail As Outlook.MailItem
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlWorksheet As Object
    Dim i As Long

    ' פתיחת תיקייה "פריטים שנשלחו"
    Set objNamespace = Application.GetNamespace("MAPI")
    Set objFolder = objNamespace.GetDefaultFolder(olFolderSentMail)

    ' פתיחת אקסל
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlWorksheet = xlWorkbook.Sheets(1)

    ' כותרות
    xlWorksheet.Cells(1, 1).Value = "שם"
    xlWorksheet.Cells(1, 2).Value = "כתובת מייל"

    ' מעבר על המיילים שנשלחו
    i = 2
    For Each objItem In objFolder.Items
        If TypeOf objItem Is Outlook.MailItem Then
            Set objMail = objItem

            ' הוספת שם וכתובת המייל לאקסל
            If objMail.To <> "" Then
                xlWorksheet.Cells(i, 1).Value = objMail.To
                xlWorksheet.Cells(i, 2).Value = objMail.SenderEmailAddress
                i = i + 1
            End If
        End If
    Next

    MsgBox "סיום ייצוא הכתובות לאקסל!", vbInformation

    ' ניקיון זיכרון
    Set objMail = Nothing
    Set objItem = Nothing
    Set objFolder = Nothing
    Set objNamespace = Nothing
    Set xlWorksheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
End Sub

לא עברתי על הקוד וכמובן שלא לוקח אחריות אם קורה משהו...

[צדיק תמים]

@ראש-פינה https://www.nirsoft.net/utils/outlook_nk2_edit.html
מחלץ את הכתובות מרשימת ההשלמה האוטומטית של אאוטלוק