adressen extrahieren

[sesser90]

Hallo,

ich habe shcon die Suchfunktin benutzt, jedoch hat sie mir nciht wirklich geholfen!

Ich benutze Outlook 2003 und möchte gerne die E-mail-Adressen aus ALLEN empfangen Mails (oder aus ausgewählten) extrahieren. Danach sollen diese zunächst den Kontakten hinzugefügt werden, wo ich sie dann gerne bearbeiten möchte.

Bitte um schnelle Hilfe

[sesser90]

hallooooo??

jemand da?


weis echt keiner die antwort?

[Betty2004]

einzelne Adressen kannst Du ja mit gedrückter Maustaste aus der Liste des Posteingangs in die Kontakte ziehen und es geht dann ein Fenster zum Weiterverarbeiten auf.

Ansonsten versuche es mal mit diesem Makro - die gewünschten Adressen müssen im Posteingang markiert sein - lege am besten erstmal einen Test-Kontaktordnerunterordner an zum Probieren:

Sub GrabInfoFromSelectedMessagesAndMakeContacts()
    Dim objNS As Outlook.NameSpace, objApp As Outlook.Application, objExp As Outlook.Explorer, objMessage As Object
    Dim objContact As Outlook.ContactItem, objSelectedFolder As Outlook.MAPIFolder, objMailItem As Outlook.MailItem
    Dim objReply As Outlook.MailItem, objItems As Outlook.Items


    'INITIALIZE REQUIRED OBJECTS
    Set objApp = New Outlook.Application
    Set objNS = objApp.GetNamespace("MAPI")
    Set objExp = objApp.ActiveExplorer


    'MAKE SURE SOMETHING IS SELECTED
    If objExp.Selection.Count = 0 Then Exit Sub


    'QUERY THE USER TO SELECT A FOLDER
    Set objSelectedFolder = objNS.PickFolder
    'MAKE SURE THIS FOLDER HAS CONTACT ITEMS AS THE DEFAULT TYPE, INDICATING THAT IT'S A CONTACT FOLDER
    If Not objSelectedFolder Is Nothing Then
        If objSelectedFolder.DefaultItemType <> olContactItem Then
            MsgBox "You must select a Contact folder.", vbOKOnly + vbExclamation, "INVALID FOLDER"
            Exit Sub
        End If
    End If


    'IF THE PICK FOLDER DIALOG IS CANCELLED, THE CONTACT WILL BE SAVED INTO THE DEFAULT CONTACTS FOLDER


    For Each objMessage In objExp.Selection
        'MAKE SURE THE SELECTED ITEM IS A MAIL MESSAGE
        If objMessage.Class = olMail Then
            Set objMailItem = objMessage
            Set objReply = objMailItem.Reply
            'CREATE THE CONTACT
            If objSelectedFolder Is Nothing Then
                Set objContact = objApp.CreateItem(olContactItem)
            Else
                Set objItems = objSelectedFolder.Items
                Set objContact = objItems.Add
            End If
            'GRAB THE NECESSARY INFO FROM THE E-MAIL MESSAGE
            objContact.FullName = objMailItem.SenderName
            objContact.Email1Address = objReply.Recipients.Item(1).Address
            objContact.Save
            objReply.Close olDiscard
        End If
    Next


    MsgBox "Contacts have been successfully created from the selected e-mail messages.", vbOKOnly, "DONE!"
End Sub

Gruß Betty

[sesser90]

ehm..blöde frage..

wie geht das mit dem makro?

[sesser90]

ach ne, ich habs jetzt danke betty hat geklappt!