import outlook contacts using access vba - two tables - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!

Categories

import outlook contacts using access vba - two tables

johbajohba Posts: 1Member
Hi,

I've got a problem importing Outlook Contacts into two joined tables. It's an address database, one table contains persons (the child table), the other one firms (the parent table)

I get the error code 3201: you cannot add or change a record because a
related record is required in table 'firmen'

Well, I expected this error, but how can I tell access that the data are related.

Here's the Code:

Function ImportOutlookContacts() As String

Dim ws As Workspace
Dim rsta As DAO.Recordset
Dim rstf As DAO.Recordset

On Error GoTo errHandler

Set ws = DBEngine.Workspaces(0)
Set rsta = CurrentDb.OpenRecordset("personen", dbOpenDynaset)
Set rstf = CurrentDb.OpenRecordset("firmen", dbOpenDynaset)

On Error GoTo errTrans

Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim objItems As Outlook.Items
Dim Prop As Outlook.UserProperty

Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
If iNumContacts <> 0 Then
For I = 1 To iNumContacts
If TypeName(objItems(I)) = "ContactItem" Then
Set c = objItems(I)
rsta.AddNew
rstf.AddNew

rsta!vorname = c.FirstName
rsta!name = c.LastName

rsta.Update

rstf!strasse = c.BusinessAddressStreet
rstf!ort = c.BusinessAddressCity
rstf!land = c.BusinessAddressState
rstf!plz = c.BusinessAddressPostalCode

rstf.Update

End If

Next I
rsta.Close
rstf.Close

MsgBox "Fertig."
Else
MsgBox "Nix zu importieren."
End If

EndIt:
Set ws = Nothing
Set rsta = Nothing
Set rstf = Nothing

Exit Function

errTrans:
MsgBox "Error ImportOutlookContacts_Click (" & Err.Number & "): " & Err.Description, vbCritical
ws.Rollback
Resume EndIt

errHandler:
MsgBox "Error ImportOutlookContacts (" & Err.Number & "): " & Err.Descrition, vbCritical
Resume EndIt

End Function

Thanks very much for any hint.

Jochen

Comments

  • dokken2dokken2 Posts: 532Member
    looks like you have it transposed, you try to 1st add the child record "rsta" when you need to 1st add the parent record in "rstf"


    rsta.AddNew
    rstf.AddNew

    rsta!vorname = c.FirstName
    rsta!name = c.LastName

    rsta.Update

    rstf!strasse = c.BusinessAddressStreet
    rstf!ort = c.BusinessAddressCity
    rstf!land = c.BusinessAddressState
    rstf!plz = c.BusinessAddressPostalCode

    rstf.Update
Sign In or Register to comment.