http://www.eksperten.dk/spm/417284

Ja, så skal du bare undlade at bruge (og medtage) paramenteren. Og så lave en .Movenext på organisationsreordsettet (og lidt andre småting). Dette skulle gøre det, vil jeg tro:

Function CopyOrg() 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)
    Do until 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
        recOrgOld.movenext
    loop
    CopyOrg = True
    Exit Function
err_CopyOrg:
    'Fejl
End Function

Takker

ah, jeg kan se, at der skal laves et par ændringer mere:

Alle de steder, hvor der stadig står lngOrgID, skal du skrive: recOrgOld!OrganisationsID

Hvordan kan det være jeg ikke skal have OrganisationsID med ind i functionen?

Og er denne linie rigtig: "Set recOrgOld = db.OpenRecordset("SELECT * FROM tblOrganisationer)"

Jeg forudsætter at jeg har mange organisationer, hvor af nogle forfindes flere gange.

Mod passende point selvfølgelig. Skal jeg oprettet et ordinært spørgsmål?

ja, linien burde hedde (bemærk at der manglede en "):

Set recOrgOld = db.OpenRecordset("SELECT * FROM tblOrganisationer")

eller lidt bedre:

Set recOrgOld = db.OpenRecordset("tblOrganisationer", dbopensnapshot)

grunden til, at OrgID ikke skal med, som parameter, skyldes jo at det ikke længere kun er én organisation, du il kigge på, men alle. Derfor gennemløbes alle OrgID'er via recOrgOld

Hvordan fortæller jeg den at det stadig kun er et OrganisationsID jeg skal have fat i, der findes bare flere med organisationern med det samme id, lidt kryptisk medgiver jeg. Min situation er selvfølgelig tilpasset din kode. Men i hovedtræk setup'et ens.

hmm, nu gjorde du mig lidt forvirret ;o)

har du flere organisationer med det samme ID???
Hvad er SÅ primærnøgle?

En anden metode er, at lave en ny procedure, som kalder funktionen fra http://www.eksperten.dk/spm/417284 flere gange i træk med forskelligt ID.


Simpelt:

Dim ID as Long
For ID = 1 to 100
  CopyOrg(ID)
Next ID

Men jeg er ikke helt sikker på, hvad det er, du vil....?

Jeg har et niveau tbl0, og jeg vil gerne kunne kopiere alle de poster i TBL1 der relaterer sig til TBL0, og derved få kopieret alle relaterede poster i TBL2 og TBL3.

Eksempel:
Sag(TBL0) - fase(TBL1) - ydelse(TBL2) - dokumentation(TBL3)

Sagen har flere faser, hvor der gennemløber nogle faser, faser indeholder nogle ydelser, ydelserne skal dokumenteres

Jeg vil gerne kunne kopier alle faser fra en sag til en anden, sagen skal altså ikke kopieres, men alle dens faser med mere.

Giver det mening?
:-)

Rettelse:
Sagen har flere faser, faser indeholder nogle ydelser, ydelserne skal dokumenteres

Hvis sagen (organisationen) ikke skal kopieres med, skal du nok bruge den sidste løsning, som jeg nævnte. Altså hvor du beholder den gamle funktion, men blot kalder den et passende antal gange.

Og hvis antallet er vilkårligt?

Det er lligeyldigt. Om du kalder den oprindelige funktion 1 eller 10000 gange er den ligeglad med (det sidste tager dog lidt længere tid ;o)

hmmmm
:-)

Jeg prøvet at tilpasse din kode, der er et lille problem omkring OrganisationsID der ikke længere er autonummeret. Men er det ellers rigtigt?

Function CopyOrgMulti(lngorgid As Long) As Boolean
On Error GoTo err_CopyOrg
Dim recOrgOld As DAO.Recordset
Dim recOrgNew As DAO.Recordset
Dim recKonOld As DAO.Recordset
Dim recKonNew As DAO.Recordset
Dim recAktOld As DAO.Recordset
Dim recAktNew As DAO.Recordset
Dim fld As DAO.Field


Dim db As Database
Set db = CurrentDb

    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)
    Do Until recOrgOld.EOF
        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 = " & recOrgOld!OrganisationsID)
        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
        recOrgOld.MoveNext
    Loop
    CopyOrgMulti = True
    Exit Function
err_CopyOrg:
    'Fejl
End Function

hmm, ja umiddelbart ser det rigtigt ud ved hurtig gennemgang...virker det ikke? Hvor fejler den? Hvad bliver ikke kopieret?

Jeg fik vist sagt før, at organisationen IKKE blev kopieret med - det gør den jo.

Undskyld, fejlen er at den ikke stopper. Jeg slipper ikke ud af loop'et. Mindre detalje :-)

nåå, pyt ;)

Hvilken af loop'sne sidder den fast i?

(Tryk Ctrl+Break og se hvor markøren står - brug F8 til at singlesteppe gennem koden)

Det første, den laver for mange organisationer.

ah..jeg tror du skal fjerne linien
recOrgOld.MoveFirst

som ligger i starten

Det hjalp ikke :-(

Jeg har lige prøvet at oprette en database med de relevante tabeller og har afprøvet nedenstående kode. Den virker!

Jeg har lavet lidt smårettelser og fjernet noget overflødig kode.

Function CopyOrgMulti(lngorgid As Long) As Boolean
On Error GoTo err_CopyOrg
Dim recOrgOld As DAO.Recordset
Dim recOrgNew As DAO.Recordset
Dim recKonOld As DAO.Recordset
Dim recKonNew As DAO.Recordset
Dim recAktOld As DAO.Recordset
Dim recAktNew As DAO.Recordset
Dim fld As DAO.Field


Dim db As Database
Set db = CurrentDb

    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)
    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 = " & recOrgOld!OrganisationsID)
    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 <> "AktivitetsIDID" 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
    CopyOrgMulti = True
    Exit Function
err_CopyOrg:
    MsgBox Err.Description
    Resume Next
End Function