[VBA / Access] Execute query met dbFailOnError

[bas.kb]

Probleempje...

Ik voer een Execute commando uit op een ADODB Database in Access en gebruik daarbij de optie dbFailOnError. De (toevoeg)query die ik uitvoer kopieert alle velden uit Tabel1 naar Tabel2. Het ontwerp van Tabel2 ligt vast, maar het ontwerp van Tabel1 wordt bepaald door een Excel bestand die ik met het TransferSpreadsheet commando importeer. Hierdoor worden de veldtypes van Tabel1 bepaald door het type van het veld in Excel.

Indien de veldtypes van Tabel1 afwijken van de (gelijknamige) veldtypes uit Tabel2, en de query uitvoer zonder de optie dbFailOnError dan worden de records gewoon gekopieerd. Ondanks dat in Tabel1, Veld1 het type Tekst heeft, en de waarde: '19-09-2007' bevat, en Tablel2, Veld2 het type 'Datum/Tijd' heeft, worden de records netjes overgezet.

Ik moet echter de dbFailOnError optie aanzetten, zodat validatieregels in Tabel2 afgaan op het moment dat er een record (middels de toevoegquery) wordt gekopieerd. Ik krijg dan netjes de melding die ik in de validatietekst heb opgegeven. Een dergelijke melding ziet er als het volgt uit: Fout: F200: Een aantal records zijn niet geimporteerd omdat dit veld geen waarde bevat.. Errnr: 3316.

Het probleem is dat de dbFailOnError optie ook de conversiefout m.b.t. de eerder genoemde kopieeractie van de Tabel1.Veld1 (Tekst) naar Tabel2.Veld2 (Datum) afvangt. Hier krijg ik de logische melding: Gegevenstypen komen niet overeen in criteriumexpressie.. Errnr: 3464.

Het is de bedoeling dat de kopieerhandeling alleen blijft steken op een validatie fout, en niet op de conversiefout (omdat Tabel1.Veld1 tekst is, en Tabel2.Veld2 datum is).

De query: INSERT INTO Tabel2 SELECT * FROM Tabel1;

De vba code:

VBScript:

    Dim db As DAO.Database
    Dim strSql As String
    Dim qryDefTabel1ToTabel2 As QueryDef
    Set db = CurrentDb
    
    Set qryDefTabel1ToTabel2 = db.QueryDefs("qryTabel1ToTabel2")
    strSql = qryDefTempToImport.SQL
    
    On Error GoTo ErrImportDisplay
    db.Execute strSql, dbFailOnError
    On Error GoTo ErrImportDisplay

Samengevat:
Als ik dus dbFailOnError uit de een-na-laatste regel weghaal worden alle records goed gekopieerd, behalve de records waar er een validatie fout optreedt, alleen wordt de foutmelding niet getoond. Als ik dbFailOnError laat staan, krijg ik netjes de validatiefout voorgeschotelt. Alleen indien er een conversiefout optreedt (die zonder dbFailOnError goed gaat) krijg je een foutmelding die ik eigenlijk wil negeren.

Hoe kan ik dit omzeilen?

[bas.kb]

Voor degene met een soortgelijk probleem:

Ik heb het anders opgelost, voordat ik de Execute met dbFailOnError uitvoer zorg ik er eerst voor de veldtypes van Tabel1 en Tabel2 gelijk zijn, middels de onderstaande functie:

VBScript:

Function SetTabel1TypeToTabel2Type()
 'create dao base
 Dim dbs As DAO.base
 'define table definitions
 Dim tdfTabel1 As DAO.TableDef
 Dim tdfTabel2 As DAO.TableDef
 'define fields
 Dim fldTabel1 As DAO.Field
 Dim fldTabel1New As DAO.Field
 Dim fldTabel2 As DAO.Field
 'set db and table defs
 Set dbs = CurrentDb
 Set tdfTabel1 = dbs.TableDefs("tblTabel1")
 Set tdfTabel2 = dbs.TableDefs("tblTabel2")
 
 'this function is implemented because otherwise
 'the dbFailOnError in the copy function
 'crashes on the conversion from text to date/time etc.
 For Each fldTabel2 In tdfTabel2.Fields
    ' check if field actually exists in Tabel1 table
    If (FieldExistsinTabel1(fldTabel2.Name, tdfTabel1)) Then
        ' in case field type from Tabel1 and Tabel2 are different then...
        If (fldTabel2.Type <> tdfTabel1.Fields(fldTabel2.Name).Type) Then
            'after a table is created the fieldtype is readonly
            'make new field, copy , delele old, rename new
            
            'check Tabel2 field type and create field
            Select Case CLng(fldTabel2.Type) 'fld.Type is Integer, but constants are Long.
                Case dbDouble: Set fldTabel1New = tdfTabel1.CreateField(fldTabel2.Name & "_new", dbDouble)    ' 7
                Case dbDate: Set fldTabel1New = tdfTabel1.CreateField(fldTabel2.Name & "_new", dbDate)        ' 8
                Case dbText: Set fldTabel1New = tdfTabel1.CreateField(fldTabel2.Name & "_new", dbText)        ' 10
            End Select
            
            'Append the field
            tdfTabel1.Fields.Append fldTabel1New
            
            'Copy the data
            strSql = "UPDATE tblTabel1 Set " & fldTabel2.Name & "_new = " & fldTabel2.Name & ";"
            dbs.Execute strSql
            
            'Delete the original field
            tdfTabel1.Fields.Delete fldTabel2.Name
            
            'Rename the new field
            fldTabel1New.Name = fldTabel2.Name
        End If
    End If
 Next fldTabel2

End Function

Op deze manier krijg ik niet die conversiefout en eventuele validatiefouten worden wel getoond.

[ Voor 3% gewijzigd door bas.kb op 20-09-2007 13:13 ]