Emailadressen exporteren (zijnde geen contactpersonen) Outlook 2013

[marceldiks]

Ik maak gebruik van Gmail en heb daarnaast Outlook als emailprogramma. Wij hebben een webwinkel www.gereedschapspecialist.nl en gaan van start met een Nieuwsbrief. Nu wil ik alle mensen die in het verleden via email contact met ons hebben gezocht, benaderen met de vraag of ze gebruik willen maken van deze gratis Nieuwsbrief. Het zijn dus geen contactpersonen in een adresboek dus exporteren werkt niet.

Is er een manier om deze emailadressen uit Outlook te krijgen?

 

[dnties]

Kijk eens in deze discussiedraad voor het maken van een lijst in Excel.

Kijk even welke gegevens jij nodig hebt, want die posting geeft alleen (resp.) het onderwerp, de timestamp van ontvangst en de afzendernaam.
Jij hebt (minstens) nog nodig:
.SenderEmailAddress
Dus zou (bijv.) kunnen werken:

Private lRow As Long, x As Date, oWS As Worksheet

Sub GetFromInbox()
    Const olFolderInbox = 6
    Dim olApp As Object, olNs As Object
    Dim oRootFldr As Object ' Root folder to start
    Dim lCalcMode As Long

    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set oRootFldr = olNs.GetDefaultFolder(olFolderInbox) '.Folders("Inbox")
    Set oWS = ActiveSheet

    x = Date
    lRow = 1
    lCalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    GetFromFolder oRootFldr
    Application.ScreenUpdating = True
    Application.Calculation = lCalcMode

    Set oWS = Nothing
    Set oRootFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
End Sub

Private Sub GetFromFolder(oFldr As Object)
    Dim oItem As Object, oSubFldr As Object

    ' Process all mail items in this folder
    For Each oItem In oFldr.Items
        If TypeName(oItem) = "MailItem" Then
[COLOR="#FF0000"]            With oItem
                'If InStr(1, .Subject, "transactions", vbTextCompare) > 0 And DateDiff("d", .ReceivedTime, x) = 0 Then
                    oWS.Cells(lRow, 1).Value = .SenderEmailAddress
                    oWS.Cells(lRow, 2).Value = .SenderName
                    oWS.Cells(lRow, 3).Value = .ReceivedTime
                    lRow = lRow + 1
                'End If
            End With
[/COLOR]        End If
    Next

    ' Recurse all Subfolders
    For Each oSubFldr In oFldr.Folders
        GetFromFolder oSubFldr
    Next
End Sub

Tijs.

 

[marceldiks]

Wat is de bedoeling van deze code

Hoi Tijs, dank voor je reactie. Ik weet niet goed wat te doen met deze code-opgave. Kun je mij daar verder mee helpen?

Gr, Marcel

 

[manamana]

Kun je hier wat mee.

https://support.office.com/nl-nl/ar...-Outlook-10f09abd-643c-4495-bb80-543714eca73f