22. oktober 2003 - 13:56Der er
9 kommentarer og 1 løsning
Kopiering af data
Jeg sidder og bakser med et problem. Den korrekte tabelstruktur er umulig at beskrive har, så derfor er nedenstående eksempel blot for at illustrere problemstillingen.
Jeg har følgende tabeller: tblOrganisationer ------------------- OrganisationsID - Autonummer Navn - Text
tblKontaktpersoner ------------------- KontaktpersonID - Autonummer OrganisationsID - Long Navn - Text Adresse - Text
tblAktiviteter ------------------- AktivitetsID - Autonummer KontaktpersonID - Long Aktivitetsnavn - text Dato - Date
Jeg ønsker nu at lave en funktion, som kan kopiere en hel organisation med tilhørende kontaktpersoner og aktiviteter. Men det drilske består i at alle kontaktpersoner og aktiviteter skal have nye ID'er. Dvs at når man har FirmaA(ID = 1) --Ole (ID = 1) ----Fødselsdag (ID = 1) ----Jubilæum (ID = 2) --Bent (ID = 2) ----Bryllup (ID = 3) ----Jubilæum (ID = 4)
og ønsker at kopiere det, så skal man ende op med følgende poster: Firma_B(ID = 2) --Ole (ID = 5) ----Fødselsdag (ID = 5) ----Jubilæum (ID = 6) --Bent (ID = 6) ----Bryllup (ID = 7) ----Jubilæum (ID = 8)
(Spørg ikke om meningen med det! Den er god nok (dette er som sagt ikke de rigtige tabeller))
Problemet er at fange de nye autonumre og føre dem videre i de nye underliggende poster.
Kunne jeg give 1000 point, gjorde jeg det gerne. Så alle gennemtænkte forslag er velkomne. /Thomas
Med version 7 af TeamShare tager Lector næste skridt og bygger en platform for AI-agenter, der i højere grad kan følge medarbejderen gennem hele arbejdsprocessen.
Function CopyOrg(lngOrgID As Long) As Boolean On Error GoTo err_CopyOrg Dim recOrgOld As Recordset Dim recOrgNew As Recordset Dim recKonOld As Recordset Dim recKonNew As Recordset Dim recAktOld As Recordset Dim recAktNew As Recordset Dim fld As field
Set recOrgNew = db.openrecordset("tblOrganisationer") Set recKonNew = db.openrecordset("tblKontaktpersoner") Set recAktNew = db.openrecordset("tblAktiviteter")
Set recOrgOld = db.openrecordset("SELECT * FROM tblOrganisationer WHERE OrganisationsID = " & lngOrgID) If Not recOrgOld.EOF Then recOrgOld.movefirst recOrgNew.addnew 'Alle felter kopieres For Each fld In recOrgOld.fields If Not IsNull(fld.Value) And Not IsEmpty(fld.Value) And fld.Name <> "OrganisationsID" Then recOrgNew.fields(fld.Name).Value = fld.Value End If Next fld Set recKonOld = db.openrecordset("SELECT * FROM tblKontaktpersoner WHERE OrganisationsID = " & lngOrgID) If Not recKonOld.EOF Then recKonOld.movefirst Do While Not recKonOld.EOF recKonNew.addnew For Each fld In recKonOld.fields If Not IsNull(fld.Value) And Not IsEmpty(fld.Value) And fld.Name <> "KontaktpersonID" Then recKonNew.fields(fld.Name).Value = fld.Value End If Next fld Set recAktOld = db.openrecordset("SELECT * FROM tblAktiviteter WHERE KontaktpersonID = " & recKonOld!kontaktpersonid) If Not recAktOld.EOF Then recAktOld.movefirst Do While Not recAktOld.EOF recAktNew.addnew For Each fld In recAktOld.fields If Not IsNull(fld.Value) And Not IsEmpty(fld.Value) And fld.Name <> "AktivitetsID" Then recAktNew.fields(fld.Name).Value = fld.Value End If Next fld recAktNew!kontaktpersonid = recKonNew!kontaktpersonid recAktNew.Update recAktOld.movenext Loop End If recKonNew.fields("OrganisationsID").Value = recOrgNew.fields("OrganisationsID").Value recKonNew.Update recKonOld.movenext Loop End If recOrgNew.Update End If CopyOrg = True Exit Function err_CopyOrg: 'Fejl End Function
Hi Thomas, not much time during the day for eksperten, but then thats not what I get paid for :o)
This is an idea, which I have tested a little, I'll leave that up to you. It obviously will need modifying with other fields which I assume there are. larsjordan's answer should, if it works, not need modifying if new fields are added.
Anyway> Make a query joining the three tables.
SELECT tblOrganisationer.OrganisationsID, tblOrganisationer.Navn AS ONavn, tblKontaktpersoner.KontaktpersonID, tblKontaktpersoner.Navn AS KNavn, tblKontaktpersoner.Adresse, tblAktiviteter.AktivitetsID, tblAktiviteter.Aktivitetsnavn, tblAktiviteter.Dato FROM tblOrganisationer LEFT JOIN (tblKontaktpersoner LEFT JOIN tblAktiviteter ON tblKontaktpersoner.KontaktpersonID = tblAktiviteter.KontaktpersonID) ON tblOrganisationer.OrganisationsID = tblKontaktpersoner.OrganisationsID;
Now make a function.
Function NewOrg(OrgID As Long) Dim LastOrgID As Long Dim LastKontaktID As Long Dim sSQL As String
Terry-> nu har jeg ikke haft tid til at kigge det nærmere gennem. Men umiddelbart ser jeg et problem i at du bruger DMax til at finde den nyeste kontaktpersonID. Fordi så duer den jo kun på én kontaktperson. Men der kan jo sagtens være 50 kontaktpersoner, hver med 50 aktiviteter. Eller har jeg ikke gennemskuet din kode godt nok? Jeg vil også kigge nærmere på dit forslag i aften eller i morgen.
Lars-> Din funktion virker næsten....den duer dog ikke hvis man har referentiel integritet mellem tabellerne (hvilket man jo selvfølgelig har). Og jeg tror, at det skyldes, at du først updater til sidst. Derved er Organisationen ikke blevet gemt før du forsøger at oprette en kontaktperson på den nye organisation. Jeg forsøgte at flytte .update-kommandoen op, så den gemte posten lige før tblkontaktpersoner blev gennemløbet. Men det resulterede i at der blev oprettet en kontaktperson for meget??
Kan du justere det lidt? (jeg har ikke tid til at kigge på det selv lige nu - så hvis du får det fikset, så er der 200 spir hjemme)
Der er yderligere 200 point, hvis du kan lave det parameterstyret (tabel og ID)og således at den selv kigger i relationerne efter relaterede tabeller! Dvs således at man blot angiver "tabel=tblOrganisationer" og "OrgID=1" og så finder den selv ud af, at der er kontaktpersoner og aktiviteter i underliggende tabeller og får dem kopieret med - det skal derfor nok være en rekursiv funktion :o)
Hvis du ikke selv kan slå op i relationerne efter underliggende tabeller, kan en anden løsning også bruges: en tabel indeholdende alle relevante tabeller med link til overliggende tabel. (Tabelnavn, Underliggende_Til_Tabel)
Dette er en svær opgave, jeg ved det....jeg ville selv synes at den var sjov at lave, men har ikke tiden til det. Derfor er I velkomne til at lege med det :o)
Så skulle den være der... Den der Movelast efter Update er for at sikre at der ikke sker "no current record". Den der med at lave den parameterstyret.....Ja, så meget tid har jeg heller ikke :-)
Function CopyOrg(lngOrgID As Long) As Boolean On Error GoTo err_CopyOrg Dim recOrgOld As Recordset Dim recOrgNew As Recordset Dim recKonOld As Recordset Dim recKonNew As Recordset Dim recAktOld As Recordset Dim recAktNew As Recordset Dim fld As Field
Set recOrgNew = db.OpenRecordset("tblOrganisationer") Set recKonNew = db.OpenRecordset("tblKontaktpersoner") Set recAktNew = db.OpenRecordset("tblAktiviteter")
Set recOrgOld = db.OpenRecordset("SELECT * FROM tblOrganisationer WHERE OrganisationsID = " & lngOrgID) If Not recOrgOld.EOF Then recOrgOld.MoveFirst recOrgNew.AddNew 'Alle felter kopieres For Each fld In recOrgOld.Fields If Not IsNull(fld.Value) And Not IsEmpty(fld.Value) And fld.Name <> "OrganisationsID" Then recOrgNew.Fields(fld.Name).Value = fld.Value End If Next fld recOrgNew.update recOrgNew.MoveLast Set recKonOld = db.OpenRecordset("SELECT * FROM tblKontaktpersoner WHERE OrganisationsID = " & lngOrgID) If Not recKonOld.EOF Then recKonOld.MoveFirst Do While Not recKonOld.EOF recKonNew.AddNew For Each fld In recKonOld.Fields If Not IsNull(fld.Value) And Not IsEmpty(fld.Value) And fld.Name <> "KontaktpersonID" Then recKonNew.Fields(fld.Name).Value = fld.Value End If Next fld recKonNew.Fields("OrganisationsID").Value = recOrgNew.Fields("OrganisationsID").Value recKonNew.update recKonNew.MoveLast Set recAktOld = db.OpenRecordset("SELECT * FROM tblAktiviteter WHERE KontaktpersonID = " & recKonOld!kontaktpersonid) If Not recAktOld.EOF Then recAktOld.MoveFirst Do While Not recAktOld.EOF recAktNew.AddNew For Each fld In recAktOld.Fields If Not IsNull(fld.Value) And Not IsEmpty(fld.Value) And fld.Name <> "AktivitetsID" Then recAktNew.Fields(fld.Name).Value = fld.Value End If Next fld recAktNew!kontaktpersonid = recKonNew!kontaktpersonid recAktNew.update recAktOld.MoveNext Loop End If recKonOld.MoveNext Loop End If End If CopyOrg = True Exit Function err_CopyOrg: 'Fejl End Function
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
