import outlook contacts using access vba - two tables

johba

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

dokken2

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