VBA voor toevoegen Multi Select aan tabel

[Jantje041]

Hoi,

Ik heb een Multi-Select List box waarvan ik de geselecteerde items naar een tabel wil kopieren. Hiervoor heb ik een VBA gemaakt. echter ik krijg het niet werkend (wel apart als formulier maar niet als subformulier). Het volgende moet gebeuren: In het Hoofdformulier maak je een record aan. In het subformulier selecteer je de items die je wil toevoegen aan het gemaakte record. Je kunt dus meerdere items toevoegen aan 1 record.

het lijkt me dat ik de relaties etc wel goed heb staan maar ik mis wat.

in de bijlage de database met meer uitleg

 

[OctaFish]

Ik snap niet zoveel van je database, maar dat komt wellicht omdat ik een beginner ben . Wat ik wél geleerd heb, is dat je tabellen en velden fatsoenlijke, betekenisvolle namen moet geven. En daar schort het m.i. wel een beetje aan. Zo heten alle sleutelvelden bij jou ID, en dat is érg onhandig. Daarnaast heb je in de tabel tblInstrProv het sleutelveld wél een fatsoenlijke naam gegeven, maar zitten er twee ID velden in die je koppelt aan twee andere tabellen, met dus óók de namen ID als sleutelveld. Je bent er dus (door schade en schande?) achter gekomen dat je één naam niet drie keer kan gebruiken, dus je hebt er twee een betere naam gegeven. Dat is prima. Ware het niet dat ik het veld IDRef dus van zijn leven lang nooit aan de tabel tblStandardDGLList zou hebben gekoppeld, maar altijd aan de tabeltblBasicDataSub (waarvan de naam dan ook weer niet klopt (je hoofdtabel DataSub noemen? Waar komt dat vandaan?). Je koppelt een hoofdtabel namelijk aan een subtabel, waarbij de hoofdtabel dan het HoofdID heeft, en de subtabel het SubID, in jouw geval heet dat dan IDRef. (En de Join eigenschappen vind ik ook dubieus...)

Maar goed, je échte probleem is dus dat je een gekoppelde tabel wilt vullen zonder dat je het HoofdID meeneemt in het verhaal. En het veld dat je probeert te koppelen aan de tabel tblStandardDGLList is ook nog eens een tekstveld; dat kan natuurlijk nooit omdat je een Autonummerveld koppelt. En dat is numeriek. Dus dat moet in ieder geval opgelost worden.

Met wat kleine aanpassingen (ook in de veldnamen dus) kom ik tot deze werkende code:

Dim ctrl As Control
Dim strSQL  As String, parID As Long
Dim varItem As Variant
Dim x As Integer


    On Error GoTo Err:
    parID = Me.Parent!Id.Value
    Set ctrl = Me.ListBoxLeft
    If ctrl.ItemsSelected.Count > 0 Then
        For Each varItem In ctrl.ItemsSelected
            strSQL = "INSERT INTO tblInstrProv(IDData, IDList, PackInst) " _
                & "Values(" & parID & ", " & ctrl.ItemData(varItem) & ", """ _
                & DLookup("PackInst", "tblStandardDGLList", "ID = " & ctrl.ItemData(varItem)) & """)"
                CurrentDb.Execute strSQL, dbFailOnError
        Next varItem
    End If
    
    For x = 0 To Me.ListBoxLeft.ListCount - 1
        Me.ListBoxLeft.Selected(x) = False
    Next x
    Me.ListBoxLeft.Requery

 

[Jantje041]

Dank je voor je tactische Feedback. Je hebt gelijk, idd niet handig om "Sub" te vermelden in de Hoofdtabel. In dit geval komt Sub van "Subjects". Begrijp de verwarring. Dus eea aangepast in de originele DB. Ook meegenomen de opmerking over "nummeriek". Op zich loopt de Code nu wel voor de IDMainData en IDList maar ik loop vast met de DLookup (al ik deze niet meeneem). Het zit 'm (vermoed ik, maar ben slechts junior en loop nog niet zo lang mee) in de """)". Enig advies?

Dim ctrl As Control
Dim strSQL  As String, parID As Long
Dim varItem As Variant
Dim x As Integer


   ' On Error GoTo Err:
    parID = Me.Parent!IDMainData.Value
    Set ctrl = Me.ListBoxLeft
    If ctrl.ItemsSelected.Count > 0 Then
        For Each varItem In ctrl.ItemsSelected
             strSQL = "INSERT INTO tblInstrProv(IDMainData, IDList, PackInst) " _
                & "Values(" & parID & ", " & ctrl.ItemData(varItem) & ", """ _
                & DLookup("PackInst", "tblStandardDGLList", "IDList = " & ctrl.ItemData(varItem)) & """)"

               CurrentDb.Execute strSQL, dbFailOnError
        Next varItem
    End If
    
    For x = 0 To Me.ListBoxLeft.ListCount - 1
        Me.ListBoxLeft.Selected(x) = False
    Next x
    Me.ListBoxLeft.Requery
End Sub

 

[OctaFish]

Ik zal naar jouw de kijken; bij mij doet-ie het prima.

 

[OctaFish]

Jouw db doet het ook prima, als je de tabelnaam in de Dlookup nog aanpast. Die is namelijk anders: tblStdDGLList en niet tblStandardDGLList.

 

[Jantje041]

Dank je voor je reactie op dit tijdstip. Bij het herschrijven heb ik een veranderde naam over het hoofd gezien. Ja, dan klopt het niet.

Ik ga volgende week naar de Opticien!!!

Dus opgelost. Dank voor je reacties. Prettige dagen