contactpersonen in specifieke outlookmap plaatsen

Ben een beginner en wil de klant contacten in mijn database kunnen toevoegen aan outlook.

Ik heb een code gevonden om vanuit access mijn nieuwe klanten in outlook. Deze werkt, maar ik wil verschillende klanten in verschillende contactmappen plaatsen die ik heb aangemaakt in outlook.

de code die ik nu gebruik is deze:

'open een outlook-contactpersoon voor de opgegeven naam

Dim appOutlook As New Outlook.Application

Dim nsOutlook As NameSpace

Dim mfContacts As MAPIFolder

Dim ciContact As ContactItem

'open de standaardmap voor contactpersonen van outlook

Set nsOutlook = appOutlook.GetNamespace("MAPI")

Set mfContacts = nsOutlook.GetDefaultFolder(olFolderContacts)

'zoek de contactpersoon met de naam van het veld KlantNaam1

Set ciContact = mfContacts.Items.Find("[FullName] = " & strFullName)

'nieuwe contactpersoon maken als contactpersoon niet gevonden is

If ciContact Is Nothing Then

Set ciContact = mfContacts.Items.Add

ciContact.FullName = strFullName

End If

'open het contactpersoonvenster van outlook

ciContact.Display

Als ik het goed heb begrepen moet ik de GetDefaultFoler(olFolderContacts) wijzigen/een toevoeging plaatsen.

De vraag is hoe doe ik dit en hoe weet ik de naam van de map die ik in contacten heb aangemaakt.

Met vriendelijke groet,

Jopie

Dit werkt bij mij

Private Sub btnNaarOutlook_Click()
   Dim appOutlook As New Outlook.Application
   Dim nsOutlook As NameSpace
   Dim mfContacts As MAPIFolder
   Dim ciContact As ContactItem


   Set nsOutlook = appOutlook.GetNamespace("MAPI")
   Set mfContacts = nsOutlook.GetDefaultFolder(olFolderContacts)

   'zoek de contactpersoon met de naam van het veld KlantNaam1
   'Set ciContact = mfContacts.Items.Count
   'MsgBox mfContacts.Items.Count

   'zoek de contactpersoon met de naam van het veld KlantNaam1
   Dim strFullName As String
   strFullName = Me.Naam & " " & Me.Voornaam
   Set ciContact = mfContacts.Items.Find("[FullName] = " & strFullName)


   'nieuwe contactpersoon maken als contactpersoon niet gevonden is
   If ciContact Is Nothing Then
       Set ciContact = mfContacts.Items.Add

       'Set ciContact = mfContacts.Items.Add
       ciContact.FullName = strFullName
       ciContact.Email1Address = Me.email
       ciContact.Save
   End If

   'Opkuisen
   Set ciContact = Nothing
   Set mfContacts = Nothing
   Set nsOutlook = Nothing
   appOutlook.Quit


End Sub

MsAccessNaarOutlook.zip

Ik heb je code getest, maar deze code vult de gegevens meteen in outlook in zonder dat het "kaartje" eerst zichtbaar wordt. Ook hier heb ik geen keuze in welke outlookmap hij komt te staan.

Ik heb een dropdownbox gemaakt waarin je kunt selecteren in welke emailgroep deze klant moet komen. Graag zou ik in outlook ook deze selectie voortzetten, zodat ik wat meer overzicht hou.

Ik zou graag zien als ik in deze groep "rechtbank" geselecteerd heb deze ook in de outlookmap rechtbank komt.

Enig idee hoe je dat moet doen?

PEB 2015 - kopie.accdb

Wat je kaartje zichtbaar maakt is

ciContact.Display

In bijlage jouw database aangepast: Er is een vak (rood gemakeerd) waar je een groep kan invullen (eventueel te halen uit een keuzelijst [Klant1])

Als de groep niet bestaat, wordt in de map contactpersonen een nieuwe groep aangemaakt.

PEB 2015plx.zip

Ik heb je versie geprobeerd, maar ik krijg een foutmelding

blauw gemarkeerd staat: appOutlook as new outlook.application

Dan een popup venster met de tekst: een door gebruiker gedifinieerd gegevenstype is niet gedefinieerd.

Ik heb ook je aanvulling in mijn database geplaatst. De groep die je bijgemaakt hebt had ik al in er al inzitten in het veld KlantEmailGroep1.

Als ik dan je code plaats en txtContacts vervang door KlantEmailGroep1 dan krijg ik de volgende foutmelding:

Compileerfout

Onjuist aantal argumenten of ongeldige eigenschappentoewijzing.

Ik ben nog maar een beginner en heb al veel uitboeken gehaald en probeer zoveel mogelijk te snappen.

met vriendelijke groet Jopie

Kijk je eens of deze het bij jou doet? Bij mij alvast wel. txtContact verwijderd ->KlantEmailGroep1

appOutlook as new outlook.application => deze fout krijg je als je geen referentie naar de outlook bbibliotheek hebt.

In het code venster ->Extra ->Vewijzingen -> Microsoft outlook ...jouw versie aanvinken.

PEB 20151111plx.zip

Ja jouw versie werkt perfect.

Ik had die outlook objecten al geïmporteerd. Toch krijg ik die foutmelding. Ook als ik jouw code die onder lblOutlook staat copieer. Had de code al zo staan.

Heb je iets veranderd in de code in de module 1 Public Sub OpenOutlookContact(strFullName As String)?

In mijn database zitten al wel meer tabellen die ook gekoppeld zijn. Zou hier het probleem misschien zitten?

Alvast bedankt.

- - - Updated - - -

Ik heb nu in je voorbeeld de andere tabellen etc. geïmporteerd. Nu werkt het wel!!!

Bedankt ik kan weer verder.

Weet je ook toevallig of het mogelijk is om zo contacten die al in outlook staan in de klanten tabel te plaatsen? Dus de omgekeerde procedure.

Mvg Jopie

Omgekeerde kan natuurlijk ook maar is het de moeite om het te programmeren?

Er is een exportfunctie naar csv -> Daarvan kan je makkelijk importeren.

Een routine om de contact in de mappen af te lopen zou er ongeveer zo uit zien:

Public Sub GetAllContacts()
   Dim olApp As Outlook.Application
   Dim olNS As Outlook.NameSpace
   Dim olContact As Outlook.MAPIFolder
   Dim FolderToCheck As Outlook.MAPIFolder
   Dim ciContact As ContactItem

   For Each FolderToCheck In olContact.Folders
      For Each ciContact In FolderToCheck.Items
           'Maak hier een record in je tabel
           MsgBox ciContact.NickName
      Next ciContact
   Next

ExitProc:
   Set FolderToCheck = Nothing
   Set olInbox = Nothing
   Set olNS = Nothing
   Set olApp = Nothing

End Sub

Bedankt, hier kan ik wat mee.