gesplitste DB toch niet van andere computer te draaien

Status
Niet open voor verdere reacties.
E

ernstcramer

Gebruiker
Lid geworden
14 dec 2015
Berichten
66
Ik heb een database met een modelverzameling.

ik heb alle tabellen ondergebracht (dmv database splitsen) op OneDrive
In mijn hoofdmenu heb ik de optie gemaakt om de verwijzende padnamen aan te passen aan de plek vanuit de computer waar ik de applicatie start.
De tabel met deze gegevens heb ik niet centraal opgeslagen, maar in de DB die ook gekopieerd moet worden.
dit is het menutje waarmee ik de padnamen kan aanpassen:

Code: 
Option Compare Database

Private Sub btnDB_Click()
    Set dlgKiezer = Application.FileDialog(msoFileDialogFolderPicker)
    With dlgKiezer
        .Title = "Waar staat de database?" 'kies de locatie waar de DB staat
        .InitialFileName = testPath '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
            strDBpath = .SelectedItems.Item(1) 'sla de locatie van de DB op
        End If
    End With
    Me.dbPath = strDBpath
    Me.dbPath.Requery
    If testPath = strDBpath Then
        Me.btnDB.BackColor = RGB(169, 209, 142)
    Else
        Me.btnDB.BackColor = RGB(255, 0, 0)
    End If
End Sub

Private Sub btnDRW_Click()
    Set dlgKiezer = Application.FileDialog(msoFileDialogFolderPicker)
    With dlgKiezer
        .Title = "Waar staan de tekeningen?" 'kies de locatie waar de tekeningen staan
        .InitialFileName = strDBpath '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
            strDRWpath = .SelectedItems.Item(1) 'sla de locatie van de DB op
        End If
    End With
    Me.drwPath = strDRWpath
    Me.drwPath.Requery
End Sub

Private Sub btnGEN_Click()
    Set dlgKiezer = Application.FileDialog(msoFileDialogFolderPicker)
    With dlgKiezer
        .Title = "Waar staan de algemene bestanden?" 'kies de locatie waar de algemene bestanden staan
        .InitialFileName = strDBpath '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
            strGENpath = .SelectedItems.Item(1) 'sla de locatie van de DB op
        End If
    End With
    Me.genPath = strGENpath
    Me.genPath.Requery
End Sub

Private Sub btnPIC_Click()
    Set dlgKiezer = Application.FileDialog(msoFileDialogFolderPicker)
    With dlgKiezer
        .Title = "Waar staan de plaatjes?" 'kies de locatie waar de afbeelingen staan
        .InitialFileName = strDBpath '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
            strPICpath = .SelectedItems.Item(1) 'sla de locatie van de DB op
        End If
    End With
    Me.picPath = strPICpath
    Me.picPath.Requery
End Sub

Private Sub Form_Load()
testPath = CurDir()
    If testPath <> Me!dbPath Then
        Me.btnDB.BackColor = RGB(255, 0, 0)
    Else
        Me.btnDB.BackColor = RGB(189, 215, 238)
    End If
End Sub

Bij het opstarten vanaf een andere computer run ik eerst apart dit menutje, zodat de padnamen zijn aangepast.
Maar op de een of andere manier gaat dat niet goed. Vandaag ontdekte ik het volgende in de tabel waarin de data wordt opgeslagen:
Knipsel-3.JPG

Hierin staat dus heel hard, bij beschrijving, de verwijzing naar de centrale DB vanaf één specifieke computer. en kennelijk helpt aanpassen van paden daar dus niets aan? Is hier een oplossing voor?
Ik dacht eerst dat ik in die regel een variabele zou kunnen opnemen die naar de juiste padnaam verwijst: dat is niet toegestaan
Moet ik alle query's ook centraal opslaan en alleen de formulieren en/of rapporten lokaal zetten?

ik hoor graag jullie advies!
 
Laatst bewerkt:
De verwijzing naar de afgesplitste tabellen wordt door access in een systeem tabel opgeslagen.
Als je rechts klikt op een van de tabellen in de lijst krijg je dit te zien:
Koppelingsbeheer.png
Kies hier de optie Koppelingsbeheer.
In het formulier klik achtereen volgens op de plekken waar de pijlen naar wijzen:
Koppelingsbeheer2.png
Na klikken op OK krijg je de FileDialog in beeld waar je de goede bestandslocatie kan kiezen.

Succes,
 
Of je gebruikt een procedure die het linken automatisch aanpast. Een constructie die overigens het best werkt als je de FE-BE op dezelfde plekken hebt staan, zodat het relatieve pad altijd hetzelfde is. Maar als de mappen in absolute zin anders zijn, kun je met een FileDialog wel de juiste map selecteren en dan werkt het ook.
 
WoutMag zei:
De verwijzing naar de afgesplitste tabellen wordt door access in een systeem tabel opgeslagen.
Na klikken op OK krijg je de FileDialog in beeld waar je de goede bestandslocatie kan kiezen.

Succes,
Klik om te vergroten...
Dank voor je reactie! Dat heb ik gedaan (moet je dus apart voor iedere tabel doen :shocked:). Bij het openen van het hoofdmenu krijg ik allerlei foutmeldingen:
Knipsel-4.JPG
Ik heb geprobeerd te achterhalen en dan blijkt dat ie op allerlei acties bij velden (bv setfocus.[veld]) kennelijk dat veld niet kan vinden...

OctaFish zei:
...kun je met een FileDialog wel de juiste map selecteren en dan werkt het ook.
Klik om te vergroten...

Dank voor je reactie: daarom had ik de code erbij gezet. Daarin gebruik ik toch "FileDialog"?
 
ernstcramer zei:
Hierin staat dus heel hard, bij beschrijving, de verwijzing naar de centrale DB vanaf één specifieke computer. en kennelijk helpt aanpassen van paden daar dus niets aan?
Klik om te vergroten...
Elke eigenschap met de naam 'Beschrijving' is niet meer dan dat: een beschrijving van waar het bij hoort. Beschrijvingen zijn optioneel, niet bindend en zeker niet gerelateerd aan een functie. Als je de tekst verwijdert, vervangt door een ander pad of vervangt door een deel van het wetboek van Timboektoe, dan zal de tabel gewoon blijven werken.
Kortom: daar ligt je probleem niet.
ernstcramer zei:
Dat heb ik gedaan (moet je dus apart voor iedere tabel doen :shocked:).
Klik om te vergroten...
Echt niet! Je kunt eerst alle tabellen selecteren (is een knop voor) en dan op OK klikken, dan zullen alle tabellen worden bijgewerkt. Het kan zijn dat je eenmalig per tabel moet aangeven waar de backend staat, maar dat gebeurt dus alleen als Access de startlocatie niet goed kan vinden. Daarna worden alle geselecteerde tabellen bijgewerkt. Het kan ook zijn dat er een tabel in de db niet gevonden kan worden, of dat je tabellen uit meerdere databases koppelt, en welk geval je daar wellicht ook nog een db moet kiezen.
Maar je gebruikt de verkeerde werkwijze en dat is de oorzaak van je probleem. Tabellen koppelen doe ik altijd automatisch met een macro en een procedure. Daarbij ga ik er zelf min of meer vanuit dat de backend in dezelfde map staat als de frontend, maar met een kleine aanpassing is dat ook m.b.v. een dialoogvenster op te zoeken. Dan krijg je zoiets:


Code: 
Public Function RefreshTables()
Dim strMsg As String, strBackend As String

    If Dir(CurrentProject.Path & "\" & CurrentProject.Name) = vbNullString Then
        strBackend = ZoekMap("Waar staat de database?")
    Else
        strBackend = CurrentProject.Path & "\" & CurrentProject.Name
    End If
    If Not strBackend = "Geen map geselecteerd" Then strMsg = RefreshTableLinks(strBackend) Else: Exit Function
    If Len(strMsg & "") = 0 Then
        Debug.Print "Alle Tabellen werden met success opnieuw gekoppeld."
    Else
        MsgBox strMsg, vbCritical
    End If

End Function

Code: 
Public Sub RefreshTablesManual()
Dim strMsg As String, strBackend As String

    strBackend = ZoekMap("Waar staat de database?")
    If Not strBackend = "Geen map geselecteerd" Then strMsg = RefreshTableLinks(strBackend) Else: Exit Sub
    If Len(strMsg & "") = 0 Then
        MsgBox "Alle Tabellen werden met success opnieuw gekoppeld."
    Else
        MsgBox strMsg, vbCritical
    End If

End Sub

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

De Manual code zit erbij om eventueel via een knop op een formulier te draaien. In een geautomatiseerd traject wil je meestal geen msgboxen zien, omdat die de code stoppen tot iemand op <OK> klikt. Als je code handmatig uitvoert, dan is het wel handig te weten dat de procedure klaar is.

De functie Public Function RefreshTables() roep ik aan via een <AutoExec> macro en die start dus automatisch als de db wordt geopend.
 
Sorry Octafish dat ik niet eerder reageerde. Ik ben een aantal dagen op dit forum uit de lucht geweest.

Dank voor je aanwijzingen. Ik ga dat proberen in te voegen.
 
@OctaFish,
Code: 
MsgBox "Alle Tabellen werden met success opnieuw gekoppeld."

Lijkt mij toch iets in de verleden tijd. Dus de code is aan vernieuwing toe. :p:d
 
@VenA: Weet je dat zeker? De Msgbox staat aan het eind, niet aan het begin :).
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan