Ga naar inhoud

ricje20

Lid
  • Items

    160
  • Registratiedatum

  • Laatst bezocht

Berichten die geplaatst zijn door ricje20

  1. hoi kweezie, het werkte nog niet,

    ik zal even me gedachtengang neerzetten.

    Huidige code (met je laatste stukje gegeven code erin)

    Private Sub Application_ItemLoad(ByVal Item As Object)
    '(Outlook 2010 VBA)
    'when you click on a mail it runs this script to check if the sender of that mail
    'is already a contact, and if he's not, open the pannel to add him to contacts
    
    Dim folContacts As Outlook.MAPIFolder
    Dim folInbox As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    ' Dim contactFolder As Outlook.Folder
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    
    Dim oNS As Outlook.NameSpace
    Dim oALijsten As Outlook.AddressLists
    Dim oALijst As Outlook.AddressList
    Dim oAEntries As Outlook.AddressEntries
    Dim oAEntry As Outlook.AddressEntry
    Dim Gebruiker As ExchangeUser
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set folInbox = oNS.GetDefaultFolder(olFolderInbox)
    Set colItems = folContacts.Items
    For Each obj In Application.ActiveExplorer.Selection
    
       If obj.Class = olMail Then
           If Not Application.ActiveExplorer.CurrentFolder.Name = "Postvak IN" And Not Application.ActiveExplorer.CurrentFolder.Parent.Name = "Postvak IN" Then
               'MsgBox "folder: " & Application.ActiveExplorer.CurrentFolder.Name
               Exit For
           'Else
               'MsgBox "folder: " & Application.ActiveExplorer.CurrentFolder.Name
           End If
    
           Set oContact = Nothing
           bContinue = True
           sSenderName = ""
           Set oMail = obj
    
           'defines the name of the sender
           sSenderName = oMail.SentOnBehalfOfName
           If sSenderName = ";" Then
              sSenderName = oMail.SenderName
           End If
    
           'sets the e-mail address of the sender
           esender = oMail.SenderEmailAddress
           Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            'sets the name of the oContact, to the name of the sender
           Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
            'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
           If Not esender Is Nothing Then
               If oContact.Email1Address = oMail.SenderEmailAddress Or oContact.Email2Address = oMail.SenderEmailAddress Or oContact.Email3Address = oMail.SenderEmailAddress Then
                   'MsgBox "Gevonden in contacts: " & sSenderName
                   Exit For
               End If
           Else
    
               'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
               esender = oMail.SenderEmailAddress
               teller = 1
    
               'loop through the available address lists
               Do While teller < oALijsten.Count + 1
                   Set oALijst = oALijsten.Item(teller)
                   Set oAEntries = oALijst.AddressEntries
                   counter = 1
    
                   'loop trough the entries of the address list
                   Do While counter < oAEntries.Count + 1
                       Set oAEntry = oAEntries.Item(counter)
    
                       'check the senders name
                       If sSenderName = oAEntry.Name Then
                           'MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
    
                           'check the senders mail address
                           Set Gebruiker = oAEntry.GetExchangeUser
                           If UCase(Gebruiker.Address) = esender Then
                               'MsgBox "mail adres gevonden : " & sSenderName & vbCrLf & "Gevonden : " & Gebruiker.PrimarySmtpAddress
                               Exit For
                           End If
                       End If
                       counter = counter + 1
                   Loop
                   teller = teller + 1
               Loop
           End If
       End If
    
       'fill in the fields of the "AddContact Pannel"
       If bContinue Then
           Set oContact = colItems.Add(olContactItem)
           With oContact
               .Email1Address = oMail.SenderEmailAddress
               .Email1DisplayName = sSenderName
               .Email1AddressType = oMail.SenderEmailType
               .FullName = oMail.SenderName
    
               '.Save
               'displays the add contact pannel
               oContact.Display
               MsgBox "Deze persoon staat nog niet in uw Contactpersonen of Adresboek, voer als mogelijk ook het telefoon nummer in."
           End With
       End If
    
    Next
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    

    in het volgende stuk

     If bContinue Then
           Set oContact = colItems.Add(olContactItem)
           With oContact
               .Email1Address = oMail.SenderEmailAddress
               .Email1DisplayName = sSenderName
               .Email1AddressType = oMail.SenderEmailType
               .FullName = oMail.SenderName
    
               '.Save
               'displays the add contact pannel
               oContact.Display
               MsgBox "Deze persoon staat nog niet in uw Contactpersonen of Adresboek, voer als mogelijk ook het telefoon nummer in."
           End With
    

    Zet je oContact zo neer, dat hij door de velden zoekt van het schermpje om iemand toe te voegen, daarin vind je email1address enzo.

    nu zeggen we hier:

            'sets the e-mail address of the sender
           esender = oMail.SenderEmailAddress
           Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            'sets the name of the oContact, to the name of the sender
           Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
            'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
           If Not esender Is Nothing Then
               If oContact.Email1Address = oMail.SenderEmailAddress Or oContact.Email2Address = oMail.SenderEmailAddress Or oContact.Email3Address = oMail.SenderEmailAddress Then
                   'MsgBox "Gevonden in contacts: " & sSenderName
                   Exit For
               End If
           Else
    

    dat hij in oContact het Email1addres, Email2address enz. moet vinden, maar hiervoor zeggen we

    Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")

    we zoeken nu dus het emailaddress in een naamveld.

    ik dacht als ik nu (zoals helemaal onderin gedaan word), eerst oContact zet naar colItems.Find(olContactItem)

    en dan na het loopje oContact weer zet naar

    Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")

    werkt het misschien.

            'sets the e-mail address of the sender
           esender = oMail.SenderEmailAddress
           Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
           Set oContact = colItems.Find(olContactItem)
    
            'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
           If Not esender Is Nothing Then
               If oContact.Email1Address = oMail.SenderEmailAddress Or oContact.Email2Address = oMail.SenderEmailAddress Or oContact.Email3Address = oMail.SenderEmailAddress Then
                   'MsgBox "Gevonden in contacts: " & sSenderName
                   Exit For
               End If
           Else
    
               'sets the name of the oContact, to the name of the sender
               Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
    

    maar dat werkte nog niet

    maar zoeken we nu wel echt de al bestaande contactpersonen door?

    want volgens mij zoekt hij nu het schermpje door waarmee je een persoon toevoegd.

    als een persoon nu als "niet bestaand contactpersoon" word gezien, ziet hij dus niet dat er in de contactpersonen het gevonden e-mailaddress al bestaat onder een contactpersoon als "2e e-mailaddress".

    op een of andere manier zouden we dan moeten zorgen dat hij kijkt in de bestaande contacten of het 2e veld e-mailadress overeenkomt met het emailaddress van de zender.. :pcguru:

    Ik hoop dat ik een beetje te volgen ben

    - - - Updated - - -

    --update--

    Misschien heb je wat aan dit screenshotje :)

    post-20361-1417705352,9363_thumb.jpg

  2. --update--

    zag hier staan

         Set oContact = colItems.Add(olContactItem)
           With oContact
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    

    Email 1 Address en Email 1 DisplayName

    moeten we dan niet ergens zorgen dat hij ook Email 2 checkt?

            Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            If Not esender Is Nothing Then
               'MsgBox "Gevonden in contacts: " & sSenderName
               Exit For
    

    misschien dat we hier dan moeten zorgen dat hij mail addres 2 langsgaat? of zit ik daar fout te proberen

  3. Hoi kweezie,

    De code werkte nog niet helemaal, dus heb wat kleine aanpassinkjes gedaan, nu doet hij het :)

    Private Sub Application_ItemLoad(ByVal Item As Object)
    '(Outlook 2010 VBA)
    'when you click on a mail it runs this script to check if the sender of that mail
    'is already a contact, and if he's not, open the pannel to add him to contacts
    
    Dim folContacts As Outlook.MAPIFolder
    Dim folInbox As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    ' Dim contactFolder As Outlook.Folder
    Dim oMail As Outlook.MailItem
    
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    
    Dim oALijsten As Outlook.AddressLists
    Dim oALijst As Outlook.AddressList
    Dim oAEntries As Outlook.AddressEntries
    Dim oAEntry As Outlook.AddressEntry
    Dim Gebruiker As ExchangeUser
    
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set folInbox = oNS.GetDefaultFolder(olFolderInbox)
    Set colItems = folContacts.Items
    
    For Each obj In Application.ActiveExplorer.Selection
    
       If obj.Class = olMail Then
          If Not Application.ActiveExplorer.CurrentFolder.Name = "Postvak IN" And Not Application.ActiveExplorer.CurrentFolder.Parent.Name = "Postvak IN" Then
               'MsgBox "folder: " & Application.ActiveExplorer.CurrentFolder.Name
               Exit For
    
    '        Else
               'MsgBox "folder: " & Application.ActiveExplorer.CurrentFolder.Name
           End If
    
           Set oContact = Nothing
           bContinue = True
           sSenderName = ""
           Set oMail = obj
    
           'defines the name of the sender
           sSenderName = oMail.SentOnBehalfOfName
            If sSenderName = ";" Then
               sSenderName = oMail.SenderName
            End If
    
            'sets the e-mail address of the sender
            esender = oMail.SenderEmailAddress
            Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            'sets the name of the oContact, to the name of the sender
            Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
           'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
            If Not esender Is Nothing Then
               'MsgBox "Gevonden in contacts: " & sSenderName
               Exit For
            Else
    
               'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
               esender = oMail.SenderEmailAddress
               teller = 1
    
               'loop through the available address lists
               Do While teller < oALijsten.Count + 1
                   Set oALijst = oALijsten.Item(teller)
                   Set oAEntries = oALijst.AddressEntries
                   counter = 1
    
                   'loop trough the entries of the address list
                   Do While counter < oAEntries.Count + 1
                       Set oAEntry = oAEntries.Item(counter)
    
                       'check the senders name
                       If sSenderName = oAEntry.Name Then
                           'MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
    '                       check the senders mail address
                           Set Gebruiker = oAEntry.GetExchangeUser
    
                           If UCase(Gebruiker.Address) = esender Then
                               'MsgBox "mail adres gevonden : " & sSenderName & vbCrLf & "Gevonden : " & Gebruiker.PrimarySmtpAddress
                               Exit For
                           End If
                       End If
                       counter = counter + 1
                   Loop
                   teller = teller + 1
               Loop
            End If
       End If
    
       'fill in the fields of the "AddContact Pannel"
       If bContinue Then
         Set oContact = colItems.Add(olContactItem)
           With oContact
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    
            '.Save
           'displays the add contact pannel
    
            oContact.Display
            MsgBox "Deze persoon staat nog niet in uw Contactpersonen of Adressboek"
           End With
       End If
    
    Next
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    

    Nu dat laatste dingetje nog, in een vorige post had ik het niet goed uitgelegd zie ik net

    wanneer een persoon dezelfde naam heeft, checkt hij alleen de eerste in de lijst.

    bijvoorbeeld:

    Rico Maartense (Rico.maartense@gmail.com)

    Rico Maartense (Rico_maartense@hotmail.com)

    in dit geval checkt hij alleen de eerste (dus gmail), dus als je hotmail en gmail hebt toegevoegd, checkt hij degene die bovenaan staat dus wanneer ik nu op een mail van het hotmail adres klik voegt hij hem toe (ook al bestaat hij al), dit is in de contactpersonen

    Daar moet bijgezegd worden,

    Wanneer een persoon toevoegd met dezelfde naam, vraag hij of je er een nieuw contact van wilt maken, of het mailadres wil toevoegen bij dat bestaande contact, wanneer je voor dat laatste kiest, komt het er zo in je contacten uit te zien (screenshot)

    post-20361-1417705348,7298_thumb.png

    in dit geval checkt hij alleen de eerste (dus hotmail), dus als je hotmail en gmail hebt toegevoegd, checkt hij degene die bovenaan staat dus wanneer ik nu op een mail van het gmail adres klik, voegt hij hem toe (ook al bestaat hij al), dit is in de contactpersonen
    (in oorspronkelijk stond er ook bij dat het in adresboek was maar dat is nu niet het geval)
  4. Hoi kweezie,

    De nieuwe versie checkt alleen in het addressboek. maar de vorige code was wel goed :)

    Private Sub Application_ItemLoad(ByVal Item As Object)
    '(Outlook 2010 VBA)
    'when you click on a mail it runs this script to check if the sender of that mail
    'is already a contact, and if he's not, open the pannel to add him to contacts
    
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim contactFolder As Outlook.Folder
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    
    Dim oNS As Outlook.NameSpace
    Dim oALijsten As Outlook.AddressLists
    Dim oALijst As Outlook.AddressList
    Dim oAEntries As Outlook.AddressEntries
    Dim oAEntry As Outlook.AddressEntry
    
    Dim Gebruiker As ExchangeUser
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    For Each obj In Application.ActiveExplorer.Selection
    
       If obj.Class = olMail Then
           Set oContact = Nothing
           bContinue = True
           sSenderName = ""
           Set oMail = obj
    
           'defines the name of the sender
           sSenderName = oMail.SentOnBehalfOfName
    
            If sSenderName = ";" Then
               sSenderName = oMail.SenderName
            End If
    
            esender = oMail.SenderEmailAddress
    
            'sets the e-mail address of the sender
            Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            'sets the name of the oContact, to the name of the sender
            Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
           'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
            If Not esender Is Nothing Then
    
    '            MsgBox "Gevonden in contacts: " & sSenderName
               Exit For
            Else
    
               'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
               esender = oMail.SenderEmailAddress
               teller = 1
    
               'loop through the available address lists
               Do While teller < oALijsten.Count + 1
                   Set oALijst = oALijsten.Item(teller)
                   Set oAEntries = oALijst.AddressEntries
                   counter = 1
    
                   'loop trough the entries of the address list
                   Do While counter < oAEntries.Count + 1
                       Set oAEntry = oAEntries.Item(counter)
    
                       'check the senders name
                       If sSenderName = oAEntry.Name Then
    '                        MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
    
    '                       check the senders mail address
                           Set Gebruiker = oAEntry.GetExchangeUser
    
                           If UCase(Gebruiker.Address) = esender Then
    '                            MsgBox "mail adres gevonden : " & sSenderName & vbCrLf & "Gevonden : " & Gebruiker.PrimarySmtpAddress
                               Exit For
                           End If
                       End If
                       counter = counter + 1
                   Loop
                   teller = teller + 1
               Loop
            End If
       End If
    
       'fill in the fields of the "AddContact Pannel"
       If bContinue Then
    
         Set oContact = colItems.Add(olContactItem)
           With oContact
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    
            '.Save
    
           'displays the add contact pannel
            oContact.Display
            MsgBox "Deze persoon staat nog niet in uw Contactpersonen of Adressboek"
           End With
       End If
    
    Next
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    
    

    alleen ben ik nog iets vergeten (had het in het bedrijf geinstalleerd alleen bleek er dus nog 1 ding niet helemaal te kloppen haha)

    een beetje vaag maar:

    als je in de concepten, een concept klikt , kwam ook het AddContact schermpje naar boven. (zonder ingevulde velden maar dat waarschijnlijk omdat een concept geen "verzender" heeft).

    ik dacht, misschien moeten we hier iets in veranderen dat hij alleen doorgaat met de check als je in de box Postvak in zit ofso

     
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    

    had al wat dingetjes geprobeerd als .select current folder if postvak in ga door (even op ze meest super simpels gezegt haha), maar kwam er niet uit.

    Ik hoop dat je me nog niet zat bent :3

  5. Dit is hem bijna

    wanneer een persoon dezelfde naam heeft, checkt hij alleen de eerste in de lijst.

    bijvoorbeeld:

    Rico Maartense (Rico.maartense@gmail.com)

    Rico Maartense (Rico_maartense@hotmail.com)

    in dit geval checkt hij alleen de eerste (dus gmail), dus als je hotmail en gmail hebt toegevoegd, checkt hij degene die bovenaan staat dus wanneer ik nu op een mail van het hotmail adres klik voegt hij hem toe (ook al bestaat hij al), dit is in de contactpersonen en adresboek.

    ik dacht misschien moeten we net zoals we door het adresboek heen "telde", ook door de contactpersonen met dezelfde naam heengaan met een teller

    ik hoop van je te horen :)

    - - - Updated - - -

    --update--

    sorry dat ik zelf nog niet zoveel mee kan doen met de code :(

    ik ben het nog een beetje aan het leren haha, ik leer hier wel een hoop van :)

  6. Hey,

    hmm.. erg moelijk uit te leggen dit :hmmmm:

    ik klik op een mail

    als de naam (email adres weet ik niet want hij voegt hem zoizo toe nu ;p) van de persoon in het adresboek staat voegt hij hem toe (altijd, 1 uitzondering, voor uitzondering zie verder xD).

    maar bij contacts, doet hij het nu perfect ;o

    Rico Maartense (rico.maartense@gmail.com) staat in contacts

    ik klik op Rico Maartense (rico_maartense@hotmail.com) en hij ziet dat het e-mail adres verschilt dus hij voegt hem toe.

    maar nu rico maartense al in contacts staat, voegt hij hem niet meer toe, ook al staat rico maartense in het adresboek (die altijd toevoegt) ...

    ... ik snap zelf amper hoe ik dit moet uitleggen lol.. ik hoop dat je het een beetje begrijpt :D

    de contacts werken nu dus goed en zoekt op e-mail. maar als de naam in het adresboek staat voegt hij hem zoizo toe behalve als de naam al in contacts staat.

    Private Sub Application_ItemLoad(ByVal Item As Object)
    '(Outlook 2010 VBA)
    'by Rico Maartense
    'when you click on a mail it runs this script to check if the sender of that mail
    'is already a contact, and if he's not, open the pannel to add him to contacts
    
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim contactFolder As Outlook.Folder
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    
    Dim oALijsten As Outlook.AddressLists
    Dim oALijst As Outlook.AddressList
    Dim oAEntries As Outlook.AddressEntries
    Dim oAEntry As Outlook.AddressEntry
    
    '' exchange rule
    Dim Gebruiker As ExchangeUser
    
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    
    
    For Each obj In Application.ActiveExplorer.Selection
       If obj.Class = olMail Then
           Set oContact = Nothing
           bContinue = True
           sSenderName = ""
           Set oMail = obj
    
           'defines the name of the sender
           sSenderName = oMail.SentOnBehalfOfName
    
            If sSenderName = ";" Then
               sSenderName = oMail.SenderName
            End If
    
            esender = oMail.SenderEmailAddress
    
            'sets esender to the e-mail address of the sender
            Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            'sets oContact, to the name of the sender
            Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
           'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
            If Not esender Is Nothing Then
               'MsgBox "Gevonden in contacts: " & sSenderName
               Exit For
            Else
    
               'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
               esender = oMail.SenderEmailAddress
               teller = 1
    
    
               'loop through the available address lists
               Do While teller < oALijsten.Count + 1
                   Set oALijst = oALijsten.Item(teller)
                   Set oAEntries = oALijst.AddressEntries
                   counter = 1
    
    
                   'loop trough the entries of the address list
                   Do While counter < oAEntries.Count + 1
                       Set oAEntry = oAEntries.Item(counter)
    
    
                'checks the senders name/email-address, if it does exit the for loop
                         If sSenderName = oAEntry.Name Then
    '                        MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
    
    
                          'exchange rule
    '                       check the senders mail address
                           Set Gebruiker = oAEntry.GetExchangeUser
                           If Gebruiker.PrimarySmtpAddress = esender Then
    '                            MsgBox "mail adres gevonden : " & sSenderName & vbCrLf & "Gevonden : " & Gebruiker.PrimarySmtpAddress
    
                               Exit For
                           End If
                       End If
                       counter = counter + 1
                   Loop
                   teller = teller + 1
               Loop
            End If
       End If
    
       'fill in the fields of the "AddContact Pannel"
       If bContinue Then
         Set oContact = colItems.Add(olContactItem)
           With oContact
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    
            '.Save
    
           'displays the add contact pannel
            oContact.Display
            MsgBox sSenderName + " staat nog niet in uw Contactpersonen of Adresboek"
           End With
       End If
    Next
    
    
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    
    End Sub
    
    
    

  7. wat voor computer / laptop heb je?

    misschien moet je even je drivers checken, klik op start > rechtermuisknop op Computer > Beheren > ga naar Apparaatbeheer > en vertel ons even op wat er staat onder Beeldschermadapters.

  8. Hey,

    Het is gewoon een klein bedrijfje ongeveer 15 mensen :)

    Ik heb net even een mailtje naar de "beheerder" gestuurd

    met de vraag:

    hebben we een eigen mailserver?

    antwoordt:

    Jawel, daar draait exchange 2007 op.

    ... exchange? maar dan zouden die "blauwe regels" ook gelden in het script :o of is dit weer wat anders?

  9. Oh,

    ben er achter gekomen dat het toch niets uitmaakt of je esender = oMail.SenderEmailAddress laat staan of niet >.<

    ik dacht eerst te waarnemen dat dit iets deed, maar blijkbaar niet ;p

    sorry!

         
       'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
               esender = oMail.SenderEmailAddress
               teller = 1
    

  10. Hey

    hij geeft nu in dat "infoboxje" het e-mail adres wel weer, maar hij zoekt er nog steeds niet op.

    ik weet niet goed hoe ik het moet uitleggen.. ik zal proberen precies te omschrijven wat er moet gebeuren.

    --

    Ik klik op een e-mail in mijn inbox.

    hij zoekt het e-mail adres van de zender van de e-mail en kijkt of het e-mail adres in contactpersonen staat (dit werkt), en hij kijkt of het e-mail adres in een adresboek staat.

    wanneer het mailadres in contactpersonen of adresboek gevonden is, (dus al bestaat), moet er niks gebeuren.

    wanneer hij nog niet bestaat dan.... (nja dat werkt al :P)

    --

    (vanaf hier even uitgaan van de " oude code ")

    waar

    If sSenderName = oAEntry.Name Then
    
    '                        MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
                           Exit For
    

    nog in staat (dus hij zoekt op naam)

    ----

    'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
               esender = oMail.SenderEmailAddress
               teller = 1
    

    hierzo had ik gevonden dat de esender weer word "hernoemd", als ik die regel zo laat staan, voegt hij elk contact toe, (de check werkt dan niet).

    Zonder de "esender = oMail.SenderEmailAddress" werkte hij eigenlijk helemaal

    behalve, dat hij op de naam zocht. en aan de hand van de naam bepaalde of de zender al in de contactpersonen of adresboek staat.

    maar het probleem dan is dat wanneer er iemand meerdere mail adressen heeft, dus dezelfde naam, maar een ander mail adress, bijv. kees derpkenderkonson (kees_derpkenderkonson@hotmail.com), kees derpkenderkonson (kees.derpkenderkonson@gmail.com). dan ziet hij het 2e adress al als een bestaant contact terwijl je alleen het eerste adres nog maar heb.

    Ik hoop dat het een beetje te begrijpen is :3, zoniet hoor ik het graag.

    (sorry dat ik zoveel op de kleine dingetjes doorga maar het moet in een bedrijf gaan runnen :3)

    
    Private Sub Application_ItemLoad(ByVal Item As Object)
    
    '(Outlook 2010 VBA)
    
    'when you click on a mail it runs this script to check if the sender of that mail
    'is already a contact, and if he's not, open the pannel to add him to contacts
    
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim contactFolder As Outlook.Folder
    
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    
    Dim oALijsten As Outlook.AddressLists
    Dim oALijst As Outlook.AddressList
    Dim oAEntries As Outlook.AddressEntries
    Dim oAEntry As Outlook.AddressEntry
    
    '' Dim Gebruiker As ExchangeUser
    
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    
    For Each obj In Application.ActiveExplorer.Selection
    
       If obj.Class = olMail Then
          Set oContact = Nothing
           bContinue = True
           sSenderName = ""
    
           Set oMail = obj
    
           'defines the name of the sender
           sSenderName = oMail.SentOnBehalfOfName
            If sSenderName = ";" Then
               sSenderName = oMail.SenderName
            End If
    
            esender = oMail.SenderEmailAddress
    
            'sets esender to the e-mail address of the sender
            Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            'sets oContact, to the name of the sender
            Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
           'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
            If Not esender Is Nothing Then
    '            MsgBox "Gevonden in contacts: " & sSenderName
               Exit For
            Else
    
               'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
       '        esender = oMail.SenderEmailAddress
               teller = 1
    
    
               'loop through the available address lists
               Do While teller < oALijsten.Count + 1
                   Set oALijst = oALijsten.Item(teller)
                   Set oAEntries = oALijst.AddressEntries
                   counter = 1
    
    
                   'loop trough the entries of the address list
                   Do While counter < oAEntries.Count + 1
                       Set oAEntry = oAEntries.Item(counter)
                       'check the senders name
    
                     'naam
                         If sSenderName = oAEntry.Name Then
    '                        MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
                           Exit For
    
                     'email
                     '     If esender = oAEntry.Address Then
                     '      'MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name & vbCrLf & "mail adres gevonden : " & oAEntry.Address
                     '       Exit For
    
    
    ''                    Else
    ''                        'check the senders mail address
    ''                        Set Gebruiker = oAEntry.GetExchangeUser
    ''                        If Gebruiker.PrimarySmtpAddress = esender Then
    
    ''                             'MsgBox "mail adres gevonden : " & sSenderName & vbCrLf & "Gevonden : " & Gebruiker.PrimarySmtpAddress
    ''                            Exit For
    ''                        End If
                       End If
                       counter = counter + 1
                   Loop
                   teller = teller + 1
               Loop
            End If
       End If
    
       'fill in the fields of the "AddContact Pannel"
       If bContinue Then
         Set oContact = colItems.Add(olContactItem)
           With oContact
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    
            '.Save
    
           'displays the add contact pannel
            oContact.Display
            MsgBox sSenderName + " staat nog niet in uw Contactpersonen of Adressboek"
           End With
       End If
    Next
    
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    
    
    

  11. Hey,

    super bedankt

    de code werkt bijna :)

    wat hij nu doet is de personen in de adresboeken op namen checken, wat eigenlijk de bedoeling is, is dat hij op e-mail adres checkt,

    omdat ik zelf bijvoorbeeld, 3 emailadressen heb met precies dezelfde naam.

    hier checkt hij op de name

    If sSenderName = oAEntry.Name Then
        MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
    Exit For
    

    ik denk dat hierin iets veranderd moet worden dat hij op email zoekt, maar ik kwam er niet helemaal uit

    ik hoop dat je me nog iets verder kunt helpen :)

    Private Sub Application_ItemLoad(ByVal Item As Object)
    
    '(Outlook 2010 VBA)
    
    'when you click on a mail it runs this script to check if the sender of that mail
    'is already a contact, and if he's not, open the pannel to add him to contacts
    
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim contactFolder As Outlook.Folder
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    
    Dim oALijsten As Outlook.AddressLists
    Dim oALijst As Outlook.AddressList
    Dim oAEntries As Outlook.AddressEntries
    Dim oAEntry As Outlook.AddressEntry
    '' Dim Gebruiker As ExchangeUser
    
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    
    For Each obj In Application.ActiveExplorer.Selection
    
       If obj.Class = olMail Then
           Set oContact = Nothing
           bContinue = True
           sSenderName = ""
           Set oMail = obj
    
           'defines the name of the sender
           sSenderName = oMail.SentOnBehalfOfName
    
            If sSenderName = ";" Then
               sSenderName = oMail.SenderName
            End If
            esender = oMail.SenderEmailAddress
    
            'sets the e-mail address of the sender
            Set esender = colItems.Find("[E-mail] = '" & esender & "'")
    
            'sets the name of the oContact, to the name of the sender
            Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
           'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
            If Not esender Is Nothing Then
    '            MsgBox "Gevonden in contacts: " & sSenderName
               Exit For
            Else
    
               'checks if the name or the e-mailadress exsist in one of the address lists, if it does exit the for loop
               Set oALijsten = oNS.AddressLists
               esender = oMail.SenderEmailAddress
               teller = 1
    
               'loop through the available address lists
               Do While teller < oALijsten.Count + 1
                   Set oALijst = oALijsten.Item(teller)
                   Set oAEntries = oALijst.AddressEntries
                   counter = 1
    
    
                   'loop trough the entries of the address list
                   Do While counter < oAEntries.Count + 1
                       Set oAEntry = oAEntries.Item(counter)
                       'check the senders name
    
                       If sSenderName = oAEntry.Name Then
                           MsgBox "Adresslijst : " & oALijst.Name & vbCrLf & "Gevonden : " & oAEntry.Name
                           Exit For
    ''                    Else
    
    ''                    'check the senders mail address
    ''                        Set Gebruiker = oAEntry.GetExchangeUser
    ''                        If Gebruiker.PrimarySmtpAddress = esender Then
    ''                              'MsgBox "mail adres gevonden : " & sSenderName & vbCrLf & "Gevonden : " & Gebruiker.PrimarySmtpAddress
    ''                            Exit For
    ''                        End If
                       End If
                       counter = counter + 1
                   Loop
                   teller = teller + 1
               Loop
            End If
       End If
    
       'fill in the fields of the "AddContact Pannel"
       If bContinue Then
         Set oContact = colItems.Add(olContactItem)
           With oContact
    
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    
            '.Save
    
           'displays the add contact pannel
            oContact.Display
            MsgBox "Deze persoon staat nog niet in uw Contactpersonen of Adressboek"
    
           End With
       End If
    Next
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    
    
    

  12. lol hier zijn we weer.....

    hij checkt alleen of het persoon al in de Contacts staat, maar hij moet ook checken of de sender al in het adresboek staat. ik zal even wat fototjes toevoegen van het adresboek dat ik bedoel.

    post-20361-1417705328,6152_thumb.png

    in dat " pad " of hoe het ook heet of hoe ik er ook kom (xD)

    moet hij ook checken of de zender van de mail die ik selecteer daarin staat, zoals hij nu al doet in de Contactpersonen.

    ik hoop dat iemand me kan helpen :adore:

  13. ooooh

    het is me gelukt haha, ik zal de oplossing nog even opgeven

     
           'sets the e-mail address of the sender
            eSender = oMail.SenderEmailAddress
    
    
            Set eSender = colItems.Find("[E-mail] = '" & eSender & "'")
    
    
           'sets the name of the sender
           Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
    
            'checks if the contact exsist, if it does exit the for loop
            If Not eSender Is Nothing Then
               Exit For
            End If
       End If
    
    

    ik heb net zoals het eerst gedaan was bij oContact, een eSender (e-mail Sender) gemaakt

    eSender = oMail.SenderEmailAddress

    en gezegt dat hij in het collom E-mail, het address van de eSender moet zoeken als hij kijkt in de contacts om te checken of hij al bestaat.

          
    'als de eSender (e-mail address van de sender van de mail) er wel staat (if not is nothing.. yup mind-fu*k) dan 'exit hij de loop, oftewel, contact bestaat al, stop het script.
    If Not eSender Is Nothing Then
               Exit For
            End If
       End If
    

    Ik hoop dat iemand hier iets mee kan haha

    Private Sub Application_ItemLoad(ByVal Item As Object)
    
    '(Outlook 2010 VBA)
    
    'when you click on a mail it runs this script to check if the sender of that mail
    'is already a contact, and if he's not, open the pannel to add him to contacts
    
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim contactFolder As Outlook.Folder
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    
    For Each obj In Application.ActiveExplorer.Selection
    
        If obj.Class = olMail Then
           Set oContact = Nothing
           bContinue = True
           sSenderName = ""
           Set oMail = obj
    
           'defines the name of the sender
           sSenderName = oMail.SentOnBehalfOfName
            If sSenderName = ";" Then
               sSenderName = oMail.SenderName
            End If
    
            eSender = oMail.SenderEmailAddress
    
            'sets the e-mail address of the sender
            Set eSender = colItems.Find("[E-mail] = '" & eSender & "'")
    
            'sets the name of the oContact, to the name of the sender
            Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
           'checks if the e-mailadress exsist in the contacts, if it does exit the for loop
            If Not eSender Is Nothing Then
               Exit For
            End If
       End If
    
       'fill in the fields of the "AddContact Pannel"
       If bContinue Then
         Set oContact = colItems.Add(olContactItem)
           With oContact
    
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    
            '.Save
    
           'displays the add contact pannel
            oContact.Display
            MsgBox "Deze persoon staat nog niet in uw Contactpersonen of Adressboek"
    
           End With
       End If
    Next
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    
    

  14. Hey,

    ik heb het al bijna opgelost, de code ziet er wat anders uit, heb het even wat overzichtelijker gemaakt.

    Sub AddAddressesToContacts(objMail As Outlook.MailItem)

    heb ik vervangen met

    Private Sub Application_ItemLoad(ByVal Item As Object)

    Hiermee heb ik ervoor gezorgt dat het script wordt uitgevoerd wanneer je op een mailtje in je inbox klikt.

    If Not (oContact Is Nothing) Then
       response = vbAbort
    If response = vbAbort Then
      bContinue = False
    End If
    End If
    

    heb ik vervangen met

            If Not oContact Is Nothing Then
                  Exit For
            End If
    

    de code hieronderzegt dat wanneer oContact al bestaat, Exit de "for loop", anders gezegd, stop het script.

    Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    

    maar nu heb ik nog een probleem.

    er staat nu, If Not oContact is Nothing Then.........

    oContact staat omschreven als de Naam van de sender van de mail,

    dus er word eigenlijk gecheckt of de naam van de zender van de mail al staat in de contactpersonen.

    hier wil ik eigenlijk dat hij zoekt op de e-mail.

    ik zat al een beetje te zoeken en dacht ongeveer iets van

    set oSendermail = ?het e-mailaddress?
    
            If Not oSendermail Is Nothing Then
               Exit For
            End If
       End If
    

    alleen heb ik geen idee hoe ik hier het e-mailaddress kan zoeken

    ik heb al geprobeerd om

    oMail.SenderEmailAddress

    te gebruiken zoals helemaal onderin de code word gedaan om het e-mailaddress te verkrijgen,

    maar hier lukte mij het niet mee.

    Ik hoop dat ik duidelijk genoeg ben en dat iemand mij kan helpen.

    Private Sub Application_ItemLoad(ByVal Item As Object)
    
    ''(Outlook 2010)
    ''when you click on a mail it runs this script to check if the sender of that mail
    ''is already a contact, and if he's not, open the pannel to add him to contacts 
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    
    
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    
    On Error Resume Next
    
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    
    
    For Each obj In Application.ActiveExplorer.Selection
       If obj.Class = olMail Then
    
    
         Set oContact = Nothing
    
    
         bContinue = True
         sSenderName = ""
    
    
         Set oMail = obj
    
    
         ''defines the name of the sender
          sSenderName = oMail.SentOnBehalfOfName
    
    
          If sSenderName = ";" Then
               sSenderName = oMail.SenderName
          End If
    
    
           ''sets the name of the contact
           Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
    
           ''checks if the contact exsist, if it does exit the for loop
            If Not oContact Is Nothing Then
               Exit For
            End If
       End If
    
    
       ''fill in the fields of the "AddContact Pannel"
       If bContinue Then
         Set oContact = colItems.Add(olContactItem)
           With oContact
    
    
            .Email1Address = oMail.SenderEmailAddress
            .Email1DisplayName = sSenderName
            .Email1AddressType = oMail.SenderEmailType
            .FullName = oMail.SenderName
    
    
             '.Save
    
    
             ''displays the add contact pannel
             oContact.Display
    
    
           End With
       End If
    Next
    
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    

  15. Hey, lang niet meer geweest hier ;p ik heb een beetje hulp nodig bij Microsoft outlook 2010 VBA

    Ik heb het in het engels geschreven omdat ik het op nog een ander forum geplaatst heb, als ik het nog even moet vertalen kan je het gerust vragen ;)

    got a little problem, I hope someone can help me.

    (Outlook 2010 VBA)

    this is my current code, what i need is when i click on a mail (only the mail i clicked on, not every mail in the folder/same place) it has to check if the Sender of the mail is already in my contacts or in the Addressbook 'All Users', and if it's not a one of those yet, open the AddContact window and fill in his/her information

    what doesn't work yet is:

    • most important of all, it doesn't run the script when i click on a mail
    • the current check if the contact already exsist doesn't work and goes with a vbMsgBox (yes or no and response stuff) wich is not what i want/need if the contact already exsist then nothing has to happen.

    I hope i gave enough information and someone can help me out here :)

    
    Sub AddAddressesToContacts(objMail As Outlook.MailItem)
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    ''don't want or need a vbBox/ask box, this a part of the current contactcheck
    ''wich doesn't work and is totaly wrong 
    Dim response As VbMsgBoxResult
    Dim bContinue As Boolean
    Dim sSenderName As String
    On Error Resume Next
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    ''this selects the mail that is currently selected.
    ''what i want is that the sender of the new incoming mail gets added to contacts
    ''(ofcourse, if that contact doesn't exsist yet)
    ''so the new incoming mail gotta be selected.
    For Each obj In Application.ActiveExplorer.Selection
    If obj.Class = olMail Then
    Set oContact = Nothing
    bContinue = True
    sSenderName = ""
    Set oMail = obj
    sSenderName = oMail.SentOnBehalfOfName
    If sSenderName = ";" Then
    sSenderName = oMail.SenderName
    End If
    Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    ''this part till the --- is wrong, i need someting to check if the contact
    ''already exsists. Any ideas?
    If Not (oContact Is Nothing) Then
       response = vbAbort
    If response = vbAbort Then
       bContinue = False
    End If
    End If
    ''---------
    If bContinue Then
    Set oContact = colItems.Add(olContactItem)
    With oContact
    .Email1Address = oMail.SenderEmailAddress
    .Email1DisplayName = sSenderName
    .Email1AddressType = oMail.SenderEmailType
    .FullName = oMail.SenderName
    '.Save
    oContact.Display
    
    End With
    End If
    End If
    Next
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    End Sub
    
    
    
    
    

    - - - Updated - - -

    uhm, sorry dat ik op me eigen post reageer, maar kon me vorige bericht niet meer bewerken omdat dat na 3 minuten niet meer kan? o.o

    de code box is crappy daar dus hier is ie even opnieuw

    
    Sub AddAddressesToContacts(objMail As Outlook.MailItem)
    
    Dim folContacts As Outlook.MAPIFolder
    Dim colItems As Outlook.Items
    Dim oContact As Outlook.ContactItem
    Dim oMail As Outlook.MailItem
    Dim obj As Object
    Dim oNS As Outlook.NameSpace
    
    ''don't want or need a vbBox/ask box, this a part of the current contactcheck
    ''wich doesn't work and is totaly wrong 
    Dim response As VbMsgBoxResult
    
    Dim bContinue As Boolean
    Dim sSenderName As String
    
    On Error Resume Next
    
    Set oNS = Application.GetNamespace("MAPI")
    Set folContacts = oNS.GetDefaultFolder(olFolderContacts)
    Set colItems = folContacts.Items
    
    ''this selects the mail that is currently selected.
    ''what i want is that the sender of the new incoming mail gets added to contacts
    ''(ofcourse, if that contact doesn't exsist yet)
    ''so the new incoming mail gotta be selected.
    For Each obj In Application.ActiveExplorer.Selection
    
    If obj.Class = olMail Then
    
    Set oContact = Nothing
    bContinue = True
    sSenderName = ""
    
    Set oMail = obj
    
    sSenderName = oMail.SentOnBehalfOfName
    If sSenderName = ";" Then
    sSenderName = oMail.SenderName
    End If
    
    Set oContact = colItems.Find("[FullName] = '" & sSenderName & "'")
    
    ''this part till the --- is wrong, i need someting to check if the contact
    ''already exsists. Any ideas?
    If Not (oContact Is Nothing) Then
       response = vbAbort
    If response = vbAbort Then
       bContinue = False
    End If
    End If
    ''---------
    
    If bContinue Then
    Set oContact = colItems.Add(olContactItem)
    
    With oContact
    .Email1Address = oMail.SenderEmailAddress
    .Email1DisplayName = sSenderName
    .Email1AddressType = oMail.SenderEmailType
    .FullName = oMail.SenderName
    
    '.Save
    
    oContact.Display
    
    End With
    End If
    End If
    
    Next
    
    Set folContacts = Nothing
    Set colItems = Nothing
    Set oContact = Nothing
    Set oMail = Nothing
    Set obj = Nothing
    Set oNS = Nothing
    
    End Sub
    
    
    

×
×
  • Nieuwe aanmaken...

Belangrijke informatie

We hebben cookies geplaatst op je toestel om deze website voor jou beter te kunnen maken. Je kunt de cookie instellingen aanpassen, anders gaan we er van uit dat het goed is om verder te gaan.