Access to Outlook Contacts with ContID

[theDBguy]

Hey DBguy,

I did change it and yes it seams to work!
Fantastic many thanks to you!!
It also created a EntryID.. it is 140 characters long is that how long the supose to be?

I should now be able to synchronise if new Entries are made yes?

Something new for me but I slowly getting there

Cheers

Glad to hear you got it working. I am not sure how long EntryID is supposed to be, all I know is it's supposed to be unique.

 

[silentwolf]

Hi thanks for your reply!

Ok well just checked and yes they are unique so it seams to work

However there are a few more questions I need to get sorted.

How to you work with Dates and Pictures in that above mentioned code?

So if

'            .Birthday = Nz(rstKontakte!Geburtsdatum)

with Nz(rstKontakte!Geburtsdatum) I get a TypeMismatch Runtime Error

Also with a Picture I still got an Error = There is no current Record .. Sorry not always exactly sure how it is translated correctly!

            Set rst2 = rstKontakte!Bild.Value
            Set fld2 = rst2!FileData
            On Error Resume Next
            Kill CurrentProject.Path & "\ContactPicture.jpg"
            On Error GoTo 0
            fld2.SaveToFile CurrentProject.Path & "\ContactPicture.jpg"
            .AddPicture CurrentProject.Path & "\ContactPicture.jpg"

Would be great to get those two also sorted to have the Code running without Errors.

Thanks for any help!

Cheers

 

[silentwolf]

Private Sub cmdKontakteExportieren_Click()
    Dim db As DAO.Database
    Dim rstKontakte As DAO.Recordset
    Dim objFolder As Outlook.Folder
    Dim objContactItem As Outlook.ContactItem
    Dim strEntryID As String
    Dim rstKommunikationsdetails As DAO.Recordset
    Dim rst2 As DAO.Recordset2
    Dim fld2 As DAO.Field2
    Set objFolder = GetFolderByPath(Me!txtOrdner)
    Set db = CurrentDb
    Set rstKontakte = db.OpenRecordset("SELECT * FROM tblKontakte", dbOpenDynaset)
    Do While Not rstKontakte.EOF
        Set objContactItem = objFolder.Items.Add(olContactItem)
        With objContactItem
            Select Case rstKontakte!AnredeID
                Case 1
                    .Gender = olMale
                Case 2
                    .Gender = olFemale
            End Select
            .FirstName = Nz(rstKontakte!Vorname)
            .LastName = Nz(rstKontakte!Nachname)
            .HomeAddressStreet = Nz(rstKontakte!Strasse)
            .HomeAddressPostalCode = Nz(rstKontakte!PLZ)
            .HomeAddressCity = Nz(rstKontakte!Ort)
            .HomeAddressCountry = Nz(rstKontakte!Land)
'            .Birthday = Nz(rstKontakte!Geburtsdatum)    'checken
            .CompanyName = Nz(rstKontakte!Firma)
            .BusinessAddressStreet = Nz(rstKontakte!FirmaStrasse)
            .BusinessAddressPostalCode = Nz(rstKontakte!FirmaPLZ)
            .BusinessAddressCity = Nz(rstKontakte!FirmaOrt)
            .BusinessAddressCountry = Nz(rstKontakte!FirmaLand)
            Set rst2 = rstKontakte!Bild.Value
            Set fld2 = rst2!FileData
            On Error Resume Next
            Kill CurrentProject.Path & "\ContactPicture.jpg"
            On Error GoTo 0
            fld2.SaveToFile CurrentProject.Path & "\ContactPicture.jpg"
            .AddPicture CurrentProject.Path & "\ContactPicture.jpg"
            Set rstKommunikationsdetails = db.OpenRecordset("SELECT * FROM qryKommunikationsdetails WHERE KontaktID = " & rstKontakte!kontaktid, dbOpenDynaset)
            Do While Not rstKommunikationsdetails.EOF
                .ItemProperties(rstKommunikationsdetails!KommunikationsartOutlook.Value) = rstKommunikationsdetails!Kommunikationsdetail
                rstKommunikationsdetails.MoveNext
            Loop
            .Save
            strEntryID = .EntryID
            rstKontakte.Edit
            rstKontakte!EntryID = strEntryID
            rstKontakte.Update
        End With
        rstKontakte.MoveNext
    Loop
End Sub

The complete Event to export to Outlook.. Accept the mdlOutlook.. but I guess you don't need that for this example.

Thanks for your help!

 

[theDBguy]

Private Sub cmdKontakteExportieren_Click()
    Dim db As DAO.Database
    Dim rstKontakte As DAO.Recordset
    Dim objFolder As Outlook.Folder
    Dim objContactItem As Outlook.ContactItem
    Dim strEntryID As String
    Dim rstKommunikationsdetails As DAO.Recordset
    Dim rst2 As DAO.Recordset2
    Dim fld2 As DAO.Field2
    Set objFolder = GetFolderByPath(Me!txtOrdner)
    Set db = CurrentDb
    Set rstKontakte = db.OpenRecordset("SELECT * FROM tblKontakte", dbOpenDynaset)
    Do While Not rstKontakte.EOF
        Set objContactItem = objFolder.Items.Add(olContactItem)
        With objContactItem
            Select Case rstKontakte!AnredeID
                Case 1
                    .Gender = olMale
                Case 2
                    .Gender = olFemale
            End Select
            .FirstName = Nz(rstKontakte!Vorname)
            .LastName = Nz(rstKontakte!Nachname)
            .HomeAddressStreet = Nz(rstKontakte!Strasse)
            .HomeAddressPostalCode = Nz(rstKontakte!PLZ)
            .HomeAddressCity = Nz(rstKontakte!Ort)
            .HomeAddressCountry = Nz(rstKontakte!Land)
'            .Birthday = Nz(rstKontakte!Geburtsdatum)    'checken
            .CompanyName = Nz(rstKontakte!Firma)
            .BusinessAddressStreet = Nz(rstKontakte!FirmaStrasse)
            .BusinessAddressPostalCode = Nz(rstKontakte!FirmaPLZ)
            .BusinessAddressCity = Nz(rstKontakte!FirmaOrt)
            .BusinessAddressCountry = Nz(rstKontakte!FirmaLand)
            Set rst2 = rstKontakte!Bild.Value
            Set fld2 = rst2!FileData
            On Error Resume Next
            Kill CurrentProject.Path & "\ContactPicture.jpg"
            On Error GoTo 0
            fld2.SaveToFile CurrentProject.Path & "\ContactPicture.jpg"
            .AddPicture CurrentProject.Path & "\ContactPicture.jpg"
            Set rstKommunikationsdetails = db.OpenRecordset("SELECT * FROM qryKommunikationsdetails WHERE KontaktID = " & rstKontakte!kontaktid, dbOpenDynaset)
            Do While Not rstKommunikationsdetails.EOF
                .ItemProperties(rstKommunikationsdetails!KommunikationsartOutlook.Value) = rstKommunikationsdetails!Kommunikationsdetail
                rstKommunikationsdetails.MoveNext
            Loop
            .Save
            strEntryID = .EntryID
            rstKontakte.Edit
            rstKontakte!EntryID = strEntryID
            rstKontakte.Update
        End With
        rstKontakte.MoveNext
    Loop
End Sub

The complete Event to export to Outlook.. Accept the mdlOutlook.. but I guess you don't need that for this example.

Thanks for your help!

Hi. Were you able to figure out the answer to your two questions, or do still need help with them?

 

[silentwolf]

I did not had to much time unfortunatelly but I tried to find something on the net but not really been able to work it out as yet.