Howdy, Stranger!

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

Categories

Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

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.