Controleren of tabel reeds bestaat.

[fmeca]

Hoi,

Voor de koppeling van de frontend met de backend database maak ik gebruik van de volgende code.

'Andere database koppelen aan Front-End programma

    Dim Source_DB As String
    Dim rs As DAO.Recordset
    Dim db As DAO.Database

    Set db = CurrentDb
    Set rs = db.OpenRecordset("a_Tabellenlijst")
    
    If MsgBox("Wilt u een andere Database / Systeem kiezen?", vbYesNo, "Database keuze") = vbYes Then
        Source_DB = [DB_File]
        Active_DB = ""
        Do Until rs.EOF
            DoCmd.DeleteObject acTable, rs!tabelnaam
            DoCmd.TransferDatabase acLink, "Microsoft Access", Source_DB, acTable, rs!tabelnaam, rs!tabelnaam
            rs.MoveNext
        Loop
        Active_DB = DLookup("Klant", "Tbl_Klant")
        'MsgBox "Nieuwe koppeling tussen databases gereed!", , "Database keuze"
    Else
        MsgBox "Koppeling database afgebroken", , "Database keuze"
    End If

Het probleem treedt op als ik een koppeling wil maken met bijv. een verkeerde of corrupte database, eerst de bestaande tabel wordt verwijderd en vervolgens wordt gekoppeld met de gekozen database.
Als in deze 'foute' database deze tabel niet voorkomt is hij al verwijderd.
Ik kan dan niet de goeie database koppelen om dat hij bij een nieuwe koppeling een tabel mist ( de te vroeg gedelete tabel)

Ik wil voor het deleten controleren of de tabel wel aanwezig is.
Indien aanwezig, dan pas deleten, indien hij niet aanwezig is gewoon doorgaan met koppelen.

Dus zoiets van:

If exists rs.tabelnaam then
DoCmd.DeleteObject acTable, rs!tabelnaam
endif

Welke code heb ik hiervoor nodig?

 

[Tardis]

Waarom je tabellen zou willen verwijderen is me eerlijk gezegd een raadsel.
Ik zou deze aanpak volgen:

http://www.mvps.org/access/tables/tbl0009.htm

Tardis

 

[fmeca]

Waarom je tabellen zou willen verwijderen is me eerlijk gezegd een raadsel.

Tardis

Iedere klant heeft een eigen database.
Dus per klant kan / wil ik de database koppelen met het Frontend prog.

Dit is makkelijk zodat ik bij een update niet alle programma's hoef aan te passen.
Ik haal gewoon alle tabellen bij de klant op en kan deze met mijn Frontend prog bewerken.

 

[Tardis]

Snap het nog steeds niet.
Bedoel je soms te zeggen dat je 1 backend hebt waar tabellen voor meerdere klanten staan?
Zo ja versta je onder klanten afdelingen/divisies/org onderdelen van 1 en hetzelfde bedrijf?
Zo nee, dan zou ik daar niet 1 backend voor gebruiken maar 1 backend per klant.

Anyway, in de link waar ik naar verwees staat ook code om te checken of een tabel bestaat.

Tardis

 

[fmeca]

Extra info

In mijn Front-end programma staan alle query's formulieren, rapporten, en een tabel met de tabelnamen die ik wil koppelen ect.
Iedere klant heeft een eigen backend DB, waar alleen tabellen in staan.

Dus als ik de gegevens van klant X wil inzien of bewerken, koppel ik deze DB met de Frontend DB. Wil ik de klant Y dan koppel ik deze DB met de Front end enz.

In de code uit de eerste post, ontkoppel ik eerst de tabel van klant X ( m.b.v. de deleteobject) vervolgens koppel ik dan dezelfde tabel van klant Y (Transferdatabase). Tot het lijstje uit de tabel 'tabelnamen' het einde bereikt heeft (EOF)

Echter als ik een corrupte file of een verkeerde (vreemde) DB kies om te koppelen, kan het voorkomen dat hij de eerste tabel wist (ontkoppelt m.b.v. deleteobject) en vervolgens in de 'verkeerde' DB deze tabel niet vindt om te koppelen (transferdatabase), de code stopt. Als ik vervolgens de juiste DB kies is de eerder verwijderde tabel niet meer aanwezig stopt het code bij de 'deleteobject'.

Ik heb overwogen om bij afsluiten van het programma weer te ontkoppelen maar als je dan meerdere malen met de zelfde backend moet werken kost het koppelen weer extra tijd.

Vandaar mijn vraag:
Hoe kan ik controleren of de tabel aanwezig is is hij niet aanwezig, de instructie 'deleteobject' overslaan en direct de tabel koppelen (transferdatabase)
m.a.w. wat moet in de 'If' instructie staan?

Misschien nu duidelijk

 

[OctaFish]

Je kunt met een Recordset de Backend openen, controleren of de te koppelen tabel bestaat en zo ja, de link deleten of gelijk opnieuw koppelen.

 

[fmeca]

Probleem opgelost

Het verdient niet de schoonheidsprijs maar het werkt.
De code kwam ik tegen op de www., met dank aan Heather L. Floyd
De eerste functie doet de koppeling tussn de FE en BE databases.
De tweede functie controleert of de tabel bestaat, indien deze niet betstaat onstaat een error die binnen de functie wordt afgehandeld. De functie retourneert dan true of false als een tabel wel resp. niet bestaat.

Function fLaad_DB(DB_File As String) As Boolean
'Andere database koppelen aan Front-End programma

    Dim Source_DB As String
    Dim rs As DAO.Recordset
    Dim db As DAO.Database

    Set db = CurrentDb
    Set rs = db.OpenRecordset("a_Tabellenlijst")
    
    On Error GoTo Err_fLaad_DB
    
    If MsgBox("Wilt u een andere Database / Systeem kiezen?", vbYesNo, "Database keuze") = vbYes Then
        Source_DB = [DB_File]
        Active_DB = ""
        Do Until rs.EOF
            If fTableExists(rs!tabelnaam) Then  'Controle of tabel in gekoppelde db bestaat
                'MsgBox rs!tabelnaam
                DoCmd.DeleteObject acTable, rs!tabelnaam
            End If
            DoCmd.TransferDatabase acLink, "Microsoft Access", Source_DB, acTable, rs!tabelnaam, rs!tabelnaam
            rs.MoveNext
        Loop
        Active_DB = DLookup("Klant", "Tbl_Klant")
        'MsgBox "Nieuwe koppeling tussen databases gereed!", , "Database keuze"
        fLaad_DB = True
    Else
        MsgBox "Koppeling database afgebroken", , "Database keuze"
        fLaad_DB = False
    End If
    Exit Function
    
Err_fLaad_DB:
    fLaad_DB = False
    MsgBox "De gekozen database bevat niet de gewenste tabellen" & vbNewLine _
    & "Maak een nieuwe keuze a.u.b.", , "DATABASE KEUZE FOUT"
    
End Function


Function fTableExists(TableName As String) As Boolean
' met dank aan Heather L. Floyd

Dim strTableNameCheck, TableExists
On Error GoTo ErrorCode

'try to assign tablename value
strTableNameCheck = CurrentDb.TableDefs(TableName)

'If no error and we get to this line, true
fTableExists = True

ExitCode:
    On Error Resume Next
    Exit Function

ErrorCode:
    Select Case Err.Number
        Case 3265  'Item not found in this collection
            TableExists = False
            Resume ExitCode
        Case Else
            MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "hlfUtils.TableExists"
            'Debug.Print "Error " & Err.number & ": " & Err.Description & "hlfUtils.TableExists"
            Resume ExitCode
    End Select

End Function