nieuwe velden creëren

Status
Niet open voor verdere reacties.

so10070

Gebruiker
Lid geworden
4 feb 2014
Berichten
419
Ik tracht nieuwe velden aan een tabel toe te voegen op basis een variabele en doe dit zo. Ik krijg telkens twee foutmeldingen:
De eerste: Deze eigenschap of methode wordt niet ondersteund door dit object
De tweede: Objectvariabele of blokvariabele With is niet ingesteld

Hier de code
Code:
Dim db As Object
        Dim rsDomein As Object
        Dim rsLeerlingen As Object
        Dim fldNieuw As Object
        Dim txtDomeinNaam As String
        Dim txtDomeinNaami As String
        
        Set db = CurrentDb
        Set rsDomein = db.OpenRecordset("tblDomein")
        
        'ga dan naar het eerste record
        rsDomein.MoveFirst
        
        For iBeginTellen = 1 To iAantalRecords 'en hier het aantal velden bijmaken
            txtDomeinNaam = rsDomein!DDomeinNaam
            txtDomeinNaami = "DomeinNaam" & iBeginTellen
            
            Set fldNieuw = rsLeerlingen.CreateField(txtDomeinNaami, dbText)
            
            rsLeerlingen.Fields.Append fldNieuw

            rsDomein.MoveNext
        Next
 
Waarom gebruik je Object variabelen en niet DAO of ADODB? Je bent bezig met recordset mutaties, pak dan ook een recordset. Dan zie je gauw genoeg wat je fout doet :).
 
Hi,

tabelobjecten aanmaken en wijzigen kan je via de ADOX cataloog. Het volgend voorbeeld creëert een tabel en voegt velden toe:

Code:
Public Function CreateTempImport() As Boolean
On Error GoTo Err_CreateTempImport
   Dim cat As New ADOX.Catalog
  Dim tblTI As ADOX.Table
  Dim col1 As ADOX.Column
  Dim col2 As ADOX.Column
  Dim col3 As ADOX.Column
  Dim col4 As ADOX.Column

  cat.ActiveConnection = CurrentProject.Connection
  Set tblTI = New ADOX.Table
  tblTI.Name = "tblTempImport"
  Set col1 = New ADOX.Column
  col1.Type = adVarWChar
  col1.DefinedSize = 50
  col1.Name = "timName"
  Set col2 = New ADOX.Column
  col2.Type = adVarWChar
  col2.DefinedSize = 50
  col2.Name = "timFirstName"
  Set col3 = New ADOX.Column
  col3.Type = adVarWChar
  col3.DefinedSize = 250
  col3.Name = "timExtraInfo"
  Set col4 = New ADOX.Column
  col4.Type = adDate
  col4.Name = "timImportDate"
  With tblTI.Columns
    .Append col1
    .Append col2
    .Append col3
    .Append col4
  End With
  With cat.Tables
    .Append tblTI
    .Refresh
  End With
  Application.RefreshDatabaseWindow
  CreateTempImport = True
Exit_CreateTempImport:
  Exit Function
Err_CreateTempImport:
  CreateTempImport = False
  MsgBox Err.Number & ": " & Err.Description
  Resume Exit_CreateTempImport
End Function
 
@OctaFish: ik gebruik objectvariabelen (late binding) omdat mijn applicatie op verschillende pc's draait en de bibliotheken niet op elke pc identiek zijn.
 
DAO is al sinds 1933 niet meer veranderd, en wordt standaard met elke Office suite geleverd, dus dat zou helemaal geen probleem mogen zijn. En zelfs met LateBinding kun je nog ontwikkelen met Early Binding; je hebt dan de structuur en de IntelliSense voorhanden om de code correct op te zetten, en die zet je dan in de laatste fase om naar LateBinding. Dat is dan vaak niet meer dan de variabelen herdefiniëren.
 
Bedankt. Ik heb je raad gevolgd en het werkt op één aspect na: ik werk met een gekoppelde database en moet dus ook het pad van de database opnemen (gaf foutmelding nr: 3057). Hierbij de code
Code:
Dim iAantalRecords As Integer
    Dim iBeginTellen As Integer
    
    'eerst nagaan hoeveel domeinen er toegekend zijn >> records tellen
    iAantalRecords = DCount("*", "tblVakDomeinen")
    
    If iAantalRecords > 0 Then
        Dim db As DAO.Database
        Dim rsVakDomein As DAO.Recordset
        Dim rsLeerlingen As DAO.TableDef
        Dim fldNieuw As DAO.Field
        Dim txtDomeinNaam As String
        Dim txtFieldi As String
        Dim strDBpad As String
        
        Set db = Application.CurrentDb
        strDBpad = Mid(CurrentDb.TableDefs("tblLeerlingen").Connect, 11)        '> zoek pad van db: tabellen zijn gelinkt en niet lokaal!
        Set db = DBEngine.OpenDatabase(strDBpad)                                    '> zet pad op gelinkte tabellen
        Set rsVakDomein = db.OpenRecordset("tblVakDomeinen")
        Set rsLeerlingen = db.TableDefs("tblLeerlingen")
        
        'populate en ga dan naar het eerste record
        rsVakDomein.MoveLast
        rsVakDomein.MoveFirst
        
        For iBeginTellen = 1 To iAantalRecords 'en hier het aantal velden bijmaken
            txtDomeinNaam = rsVakDomein!DNaam
            txtFieldi = "DomeinNaam" & iBeginTellen
           
            Set fldNieuw = rsLeerlingen.CreateField(txtFieldi, dbText, 50)
            rsLeerlingen.Fields.Append fldNieuw
            
            rsVakDomein.MoveNext
        Next
    End If
    
    fldNieuw.Close
    rsVakDomein.Close
    db.Close
    
    Set fldNieuw = Nothing
    Set rsVakDomein = Nothing
    Set rsLeerlingen = Nothing
 
Ik schrijf 'm een stuk korter (en vermoedelijk sneller).
Code:
Sub opl()
Dim iT As Integer
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim tdf As DAO.TableDef
Dim fldNieuw As DAO.Field
Dim strDBpad As String
    strDBpad = Mid(CurrentDb.TableDefs("tblLeerlingen").Connect, 11)
    Set db = DBEngine.OpenDatabase(strDBpad)                                    '> zet pad op gelinkte tabellen
    Set rst = db.OpenRecordset("tblVakDomeinen")
    Set tdf = db.TableDefs("tblLeerlingen")
    If Not rst.RecordCount = 0 Then
        Do While Not rst.EOF
            iT = iT + 1
            txtDomein = rst!DNaam
            Set fldNieuw = tdf.CreateField("DomeinNaam" & iT, dbText, 50)
            tdf.Fields.Append fldNieuw
            rst.MoveNext
        Loop
    End If
End Sub
En dan heb ik de (verder m.i. ongebruikte) regel txtDomein = rst!DNaam nog laten staan :).
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan