controle op (ontbrekende) koppellingen

DirkVS · 10 okt 2019

Beste forumleden,

ik wens op mijn formulier een knop te zetten met code die gaat controleren of er voor elke tabel in de back-end een gekoppelde tabel is in de front-end en wanneer die ontbreekt dient deze aangemaakt.
Is dit mogelijk?

OctaFish · 10 okt 2019

Ja, dat kan. En die procedure gebruik ik regelmatig. Ik zal vanavond de code even opzoeken.

DirkVS · 10 okt 2019

@OctaFish
prachtig! dank je wel

OctaFish · 11 okt 2019

Nog geen tijd voor gehad, maar zal hem zo posten.

NoellaG · 12 okt 2019

Hoi,

ik heb geen volledige oplossing liggen, maar kan je misschien op pad zetten met de volgende functies:

Functie om links in andere database op te vragen en in het voorbeeld sla ik ze op in een tabel:

Code:

Public Function CheckTables() As Double
On Error GoTo Err_CheckTables

    Dim cnn As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim cmd As New ADODB.Command
    Dim cat As New ADOX.Catalog
    Dim tbd As ADOX.Table
    Dim strSQL As String
    Dim lngLevel As Long
    Dim strStandaardTaal As String

    'kijkt als de versie up to date is
    lngError = 0
    
    cnn.ConnectionString = GetConnectionString("[NaamGekoppeldAccessBestand]")
    cnn.Open
   'verwijder bestaande records
    Set cat.ActiveConnection = cnn
    strSQL = "Delete from tblLinkedTables"
    cmd.CommandType = adCmdText
    cmd.CommandText = strSQL
    cmd.ActiveConnection = CurrentProject.Connection
    cmd.Execute
    'voeg nieuwe records toe
    rst.Open "tblLinkedTables", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
    For Each tbd In cat.Tables
        With rst
            .AddNew
            !ltName = tbd.Name
            .Update
        End With
    Next tbd
    rst.Close
    cnn.Close

Exit_CheckTables:
    
    Set cat = Nothing
    Set cnn = Nothing
    Set rst = Nothing
    Set tbd = Nothing
    Exit Function
    
Err_CheckTables:
    CheckTables = -1
    lngError = 11
    Debug.Print Err.Number & ": " & Err.Description
    Resume Exit_CheckTables

End Function

Als de database een andere Access database is kan je de connectiestring via de volgende functie opvragen:

Code:

Public Function GetConnectionString(strDatabase As String) As String
On Error GoTo Err_GetConnectionString

    Dim cnn As ADODB.Connection
    Dim strConn As String
    Dim intPos As Integer, intPos2 As Integer
    
    Set cnn = CurrentProject.Connection
    strConn = cnn.ConnectionString
    intPos = InStr(strConn, "Data Source=")
    intPos2 = InStr(intPos, strConn, ";")
    strConn = Left(strConn, intPos - 1) & "Data Source=" & strDatabase & Right(strConn, Len(strConn) - intPos2 + 1)
    GetConnectionString = strConn
    

Exit_GetConnectionString:
    Set cnn = Nothing
    Exit Function
    
Err_GetConnectionString:
    GetConnectionString = "#ERR in getConnectionString: " & Err.Number & " - " & Err.Description
    Resume Exit_GetConnectionString

End Function
 Als je database in een ander formaat is moet je deze laatste functie natuurlijk aanpassen.

Niet volledig, maar je kan misschien al starten.  De voorbeelden hebben wel een reference naar de ADODB en ADOX bibliotheken nodig.

Vriendelijke groeten
Noëlla

DirkVS · 13 okt 2019

@NoellaG
bedankt voor je reply, maar ik krijg een foutcode als ik Foutopsporing/Database compileren laat lopen (zie bijlage)

"Compileerfout: Een door de gebruiker gedefineerd gegevenstype is niet gedefineerd" en de lijn met "Dim cnn As New ADODB.Connection" wordt opgelicht.
Dat zal allicht te maken hebben met wat je onder je code vermeldt: "De voorbeelden hebben wel een reference naar de ADODB en ADOX bibliotheken nodig".
Ik heb in Extra/Verwijzigingen de beschikbare verwijzingen overlopen, maar zie niks dat ADODB of ADOX vermeldt.
Wat moet ik doen om de foutmelding weg te krijgen?
Mvg, DirkVS

NoellaG · 13 okt 2019

ADOX library = Microsoft ADO ext. for DDL and Data security
ADODB library = Microsoft ActiveX Data Objects

De versie hangt af van je Access en Windows versie

vrGroeten
Noëlla

DirkVS · 13 okt 2019

@NoellaG
ik heb 2 verwijzingen naar "Microsoft ADO ext." en een hele lijst verwijzingen naar "Microsoft ActiveX Data Objects " (zie kader)

Welke moet ik aanvinken?
Ik werk met Windows 10 Home versie 1903 en Access versie 14.0.7237.5000 (32-bits)
mvg, DirkVS

NoellaG · 13 okt 2019

Als je niet ontwikkelt voor andere machines, neem de hoogst aanwezige versie, in jou geval:
Microsoft ActiveX Data Objects 6.1 Library
Microsoft ADO ext. 6.0 for DDL and Data security

DirkVS · 13 okt 2019

OK, heb deze aangevinkt.
Krijg nu volgende foutmelding (zie kader):

mvg, Dirk

NoellaG · 13 okt 2019

Dag Dirk,

de code is een stuk van een bestaande applicatie die ik gekopieerd heb en wat aangepast. De regel die je aanduidt is een lijn uit de gekopieerde code die ik vergeten te verwijderen ben, sorry

DirkVS · 13 okt 2019

Noella

heb die lijn uitgezet, maar krijg nog een foutmelding:

moet ik vermoedelijk ook uitzetten?
Dirk

NoellaG · 13 okt 2019

DirkVS · 13 okt 2019

Noella
dit had ik ondertussen reeds gedaan. En omdat jouw code 2 functies betreffen, heb ik op mijn form 2 opdrachtknoppen gezet waarin ik telkens 1 functie oproep.
Voor CheckTables gebeurt er helaas niks, en voor GetConnectionString krijg ik nog een foutmelding: "Compileerfout - Het argument is niet optioneel."
Dit gaat allemaal ver boven mijn petje want mijn kennis v VBA is zeer beperkt.
Wat moet ik doen?
mvg, Dirk

NoellaG · 13 okt 2019

Even stap voor stap:
1.je maakt in je access applicatie een tabel met de naam tblLinkedTables: 2 velden ltID = autonumber en PK veld ; ltName = tekstveld (255 chars)
2. de tweede functie is een functie die binnen in de eerste dient gebruikt te worden. Deze functie gaat een connectiestring opbouwen naar je gelinkte database in het geval dit ook een access bestand is . Hierbij vervang je [NaamGekoppeldAccessBestand] door de naam van je gekoppeld access bestand. Dit is het argument dat de functie nodig heeft. Zij geeft een tekststring terug waarmee een ODBC connectie naar deze access kan opgebouwd worden. maw waarmee VBA het andere bestand kan openen en uitlezen
3. Je kan dan de eerste functie al eens testen: normaal moet dan in de tabel tblLinkedTables een lijst met alle tabellen in de huidige database komen te staan
4. Pas de code lijn

Code:

rst.Open "tblLinkedTables", CurrentProject.Connection, adOpenKeyset, adLockOptimistic

aan naar

Code:

rst.Open "tblLinkedTables", cnn, adOpenKeyset, adLockOptimistic

Met currentproject.connection kijkt de code in de huidige database, met de connectie cnn gaat de functie kijken naar de gekoppelde database.
4. Om de controle uit te voeren kan je bijvoorbeeld 2 werktabellen maken : tblLinkedTables met de tabelnamen uit de gekoppelde database en tblCurrentTables met de tabelnamen uit de database van waaruit je werkt.
5. Je kan dan met een query met een outer join gaan kijken welke tabellen er in tblLinkedTables staan en niet in tblCurrentTables voorkomen

Je kan om te testen de tweede functie apart aanroepen in het immediate venster, maar dan moet je ook de naam van de gekoppelde database meegeven:
bv. ? GetConnectionString("mijnDB.accdb"). Maar het is dus de bedoeling dat deze functie binnen de eerste functie opgeroepen wordt.

Vriendelijke groeten
Noëlla

DirkVS · 13 okt 2019

@Noella,
ok, ik ga dit eens op mijn gemak bekijken en testen. Ik laat dan nog wel iets weten.
Alvast bedankt voor je geduld.
En nog een prettig WE !
mvg, Dirk

DirkVS · 14 okt 2019

@Noella
ik heb nauwgezet je instructies gevolgd, maar het werkt niet.
In 2. heb ik de naam vh gekoppeld bestand ingevuld (waarmee toch de Back-end bedoeld wordt hé), maar krijg telkens in het direct-venster "-2147467259: Kan het bestand C:\Users\Dirk\Documents\[TEST_BE.accdb] niet vinden." maar de bestanden staan niet in de map Documents. Ik heb ze dan verplaatst naar de map Documents maar die foutmelding blijft.
Als naam vd BE heb ik volgende variaties geprobeerd: [TEST_BE.accdb], [TEST_BE], TEST_BE.accdb, TEST_BE. Niks werkt, telkens wordt gezegd dat het bestand niet gevonden wordt.
In 2. heb je het ook over de ODBC connectie. Maar mijn tabel is gewoon gekoppeld, niet met ODBC. Ligt het daar misschien aan?
mvg, Dirk

OctaFish · 14 okt 2019

Laat ik dan ook maar een steentje in de vijver gooien

. Had tenslotte mijn code nog beloofd.

Code:

Option Compare Database
Const BackendPad As String = "G:\Beleid\CRM\Access\Startpunt V2.0\Backend\"
'—————————————————————————-
' Procedure: RefreshTableLinks
' Purpose: Refresh table links to back-ends in the same folder as front end.
' Note: Linked Tables can be in more than one back-end.
' Return: Returns a zero-length string if all tables are relinked.
' Return: Or returns a string listing tables not relinked and errors.
'—————————————————————————-

Code:

Public Function RefreshTables()
Dim strMsg As String, strBackend As String, strSQL As String
Dim rs As DAO.Recordset
Dim bNew As Boolean
Dim tmp As Variant

    strSQL = "SELECT Top 1 Id, Backend_pad, Backend From tInstellingen Order By ID Desc"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    With rs
        If Not !Backend_pad = vbNullString Then
            strBackend = !Backend_pad & IIf(Right(!Backend_pad, 1) <> "\", "\", "") & !BackEnd
            If Dir(strBackend) = "" Then strBackend = ZoekMap("Waar staat de database?"): bNew = True
        Else
            strBackend = ZoekMap("Waar staat de database?"): bNew = True
        End If
        If bNew = True And Not strBackend = "Geen map geselecteerd" Then
            tmp = Split(strBackend, "\")(UBound(Split(strBackend, "\")))
            .AddNew
            !Backend_pad = Left(strBackend, Len(strBackend) - Len(tmp))
            !BackEnd = tmp
            .Update
        End If
        .Close
    End With
    If Not strBackend = "Geen map geselecteerd" Then
        strMsg = RefreshTableLinks(strBackend)
    Else
        Exit Function
    End If
    If Len(strMsg & "") = 0 Then
        Debug.Print "Alle Tabellen werden met success opnieuw gekoppeld."
    Else
        MsgBox strMsg, vbCritical
    End If
End Function

Code:

Public Function RefreshTableLinks(Optional BackEnd As String) As String
On Error GoTo ErrHandle

Dim tdf As DAO.TableDef
Dim strCon As String
Dim strBackend As String
Dim strMsg As String, strFields As String
Dim intErrorCount As Integer
Dim tmp As Variant
Dim fld As DAO.Field

    '-----------------------------------------------------------------------------------------------------
    'Door alle tabellen in de TableDefs Collectie lussen.
    '-----------------------------------------------------------------------------------------------------
    If BackEnd = vbNullString Then
        strBackend = CurrentProject.Path & "\Backend\"
    Else
        strBackend = BackEnd
    End If
    For Each tdf In CurrentDb.TableDefs
        If Left$(tdf.Connect, 10) = ";DATABASE=" Then       'Tabel is een gelinkte tabel.
            If Left(tdf.Name, 1) = "~" Then
                strFields = ""
            Else
                strCon = Nz(tdf.Connect, "")                    'Lees de Connection String uit.
                '-----------------------------------------------------------------------------------------
                'Gebruik de SPLIT opdracht om de back-end database naam te splitsen.
                '-----------------------------------------------------------------------------------------
                tmp = Split(strCon, "\")(UBound(Split(strCon, "\")))
                '-----------------------------------------------------------------------------------------
                'Checken of we een Access database te pakken hebben
                '-----------------------------------------------------------------------------------------
                If InStr(1, tmp, "mdb") > 0 Or InStr(1, tmp, "accdb") > 0 Then
                    On Error Resume Next
                    '-------------------------------------------------------------------------------------
                    'De nieuwe Connection String opbouwen en verversen.
                    '-------------------------------------------------------------------------------------
                    Set tdf = db.TableDefs(tdf.Name)
                    '-------------------------------------------------------------------------------------
                    ''tdf.Connect = ";DATABASE=" & BackendPad & tmp(UBound(tmp))
                    Dim strConNew As String
                    strConNew = ";DATABASE=" & strBackend & tmp
                    tdf.Connect = strConNew
                    tdf.RefreshLink
                Else
                    '-------------------------------------------------------------------------------------
                    'Als er een foutje is: de foutmelding toevoegen aan de foutmeldingsboodschap.
                    '-------------------------------------------------------------------------------------
                    intErrorCount = intErrorCount + 1
                    strMsg = strMsg & "Niet gelukt om de back-end database naam uit te lezen." & vbNewLine
                    strMsg = strMsg & "Tabel Naam: " & tdf.Name & vbNewLine
                    strMsg = strMsg & "Connect = " & strCon & vbNewLine
                End If
            End If
        End If
    Next tdf

'---------------------------------------------------------------------------------------------------------
'En alles netjes opruimen
'---------------------------------------------------------------------------------------------------------
ExitHere:
    On Error Resume Next
    If intErrorCount > 0 Then
        strMsg = "Er waren " & intErrorCount & " problemen met het verversen van de tabel links: """ _
            & vbNewLine & strMsg & "In Procedure RefreshTableLinks"""
        RefreshTableLinks = strMsg
        Debug.Print strMsg
    End If
    Set tdf = Nothing
    Exit Function
    
ErrHandle:
    On Error Resume Next
    intErrorCount = intErrorCount + 1
    strMsg = strMsg & "Error " & Err.Number & " " & Err.Description
    strMsg = strMsg & vbNewLine & "Tabel Naam: " & tdf.Name & vbNewLine
    strMsg = strMsg & "Connect = " & strCon & vbNewLine
    Resume ExitHere

End Function

Code:

Private Function ZoekMap(Optional Titel As String) As String
Dim strDBPath As Variant
Dim dlgKiezer As FileDialog
    
    Set dlgKiezer = Application.FileDialog(msoFileDialogFolderPicker)
    With dlgKiezer
        .Title = Titel                                          'kies de start locatie
        .InitialFileName = CurrentProject.Path & "\Backend\"    'openen in de map waar de DB staat
        .AllowMultiSelect = False                               'je kan maar één map kiezen
        If .Show = -1 Then                                      'bepaal of gebruiker op OK-knop heeft geklikt
            ZoekMap = .SelectedItems.Item(1) & "\"              'sla de locatie van de DB op
        Else
            ZoekMap = "Geen map geselecteerd"
        End If
    End With
End Function

Hier zit volgens mij alles in wat je nodig hebt. Het enige dat ik (nog) niet geautomatiseerd heb, is het opslaan van de BE database als ik hem moet opzoeken met de blader functie. Maar dat is een simpele Insert in de tabel tInstellingen.

NoellaG · 14 okt 2019

Hoi,
het oproepen van de functie

? GetConnectionString("TEST_BE.accdb")

zou iets moeten opleveren als:

Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=TEST_BE.accdb;Mode=Share Deny None;Extended Properties="";Jet OLEDB:System database=C:\Users\Noella Gabriel\AppData\Roaming\Microsoft\Access\System.mdw;Jet OLEDB:Registry Path=Software\Microsoft\Office\16.0\Access\Access Connectivity Engine;Jet OLEDB

atabase Password="";Jet OLEDB:Engine Type=5;Jet OLEDB

atabase Locking Mode=1;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB

on't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=True;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False

Deze string wordt dan gebruikt als connectiestring om je backend database te openen. Dat is de string voor een "gewone" koppeling naar een ander Access bestand. Deze loopt standaard via OLEDB als je niets speciaals doet.

DirkVS · 16 okt 2019

@Noella

wanneer ik "? GetConnectionString("TEST_BE.accdb")" intik in het Direct venster krijg ik een foutmelding:
"Compileerfout: Sub of Function is niet gedefinieerd."

mvg, Dirk

controle op (ontbrekende) koppellingen

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Gebruiker

Verenigingslid

Terugkerende gebruiker

Gebruiker

Wij waarderen jouw privacy