Avatar billede tigerdyr2007 Praktikant
29. august 2010 - 19:13 Der er 1 løsning

Problem i flerbruger løsning med FE/BE

Hej eksperter.

Jeg har en DB, som er delt i FE/BE, begge som .MDB filer.
Der er en BE på en fælles server, hver bruger (to stk.) har sin egen FE.
Når jeg starter DB på maskine nr. 2 sker der ikke mere indtil jeg lukker på maskine 1. Dette mener jeg skyldes den kode jeg kører som kontrollerer om tabellerne er linket korrekt, og evt. opdaterer links. Der er i hvert fald ingen problemer når jeg slår denne fuktion fra.
Den kode jeg kører til opdatering af tabeller er indsat herunder.

Nogen der har en ide om hvad der er galt?
Jeg vil selv tro det er omkring .connect, men jeg er ikke helt skarp på dette område.
Det er umiddelbart kun de to første funktioner som er interressante, resten er små hjælpe funktioner.

Jeg kører Access 2007/2007.

Takker for hjælpen.

Function connect()
    On Error Resume Next
    Dim strFileAndPath As String
   
    Dim db As DAO.Database
    Dim tdef As DAO.TableDef
    Dim foundfile As Boolean
    foundfile = False
        'Dim db As DAO.Database, xdb As Database
        'Dim rs As DAO.Recordset
        'Dim tmptable As TableDef
        'Dim path As String, mdb As String, Filnavn As String
        'Dim n As Integer, mdbOK As Boolean
        'Dim filter As String, Felt As Variant
       
    strFileAndPath = GetBackend 'find backend
   
    If Dir(strFileAndPath) = "" Then 'der er problemer, DB ikke hvor den var sidst, fortsæt
        strFileAndPath = FindNewFileAndPath(strFileAndPath) 'find fil
        foundfile = True
       
        Set db = CurrentDb
        For n = 0 To db.TableDefs.Count - 1 ' test hver eneste tabel-link
          'If Len(tdef.connect) > 0 Then
          If Left(db.TableDefs(n).connect, 9) = "MS Access" Then
                'MsgBox Err
                db.TableDefs(n).connect = "MS Access;PWD=" & backend_PW & ";DATABASE=" & strFileAndPath
                'MsgBox Err
                DCount "*", db.TableDefs(n).name
                'MsgBox db.TableDefs(n).name
                'MsgBox Err
                If Err <> 0 Then 'Problem, ingen forbindelse for den pågældende tabel, spørg efter ny fil
                    Err.Clear
                    'MsgBox strFileAndPath
                    strFileAndPath = FindNewFileAndPath(strFileAndPath) 'find fil
                    foundfile = True
                End If
                If Err <> 0 Then
                    MsgBox "hmm"
                    RefreshLinks = False
                    DoCmd.Hourglass False
                    Err.Clear
                    Exit Function
                End If
            End If
            If foundfile = True Then
                Exit For 'test kun indtil en tabel er fundet, og ext løkke, kør så connect på alle tabeller - to bad hvis der så mangler en!
            End If
        Next n
    Else 'filen fandtes gør intet
        'strFileAndPath = FindNewFileAndPath(strFileAndPath) 'find fil
    End If
   
    AttachAll (strFileAndPath)

End Function

Function AttachAll(strFileAndPath As String)
'Funktion til at linke alle tabeller til den ny-valgte DB BE-fil.
On Error GoTo err_handler

Dim db As DAO.Database
Dim tdef As DAO.TableDef

If Dir(strFileAndPath) <> "" Then
    Set db = CurrentDb
    For Each tdef In db.TableDefs
        If Len(tdef.connect) > 0 Then
            tdef.connect = "MS Access;PWD=" & backend_PW & ";DATABASE=" & strFileAndPath
            Err = 0
            'On Error Resume Next
            tdef.RefreshLink
            If Err <> 0 Then
                RefreshLinks = False
                DoCmd.Hourglass False
                Exit Function
            End If
        End If
    Next tdef
End If

Exit Function

err_handler:
    MsgBox Err, vbCritical, "Fejl"
    Exit Function

End Function

Function FindNewFileAndPath(strFileAndPath As String) As String
Dim dlg As New CommonDialog

    '<<----Åbn Commondialog-boksen---->>
    dlg.filter = "Access databaser" & vbNullChar & "*.mdb;*.mda;*.mde;*.mdw" & vbNullChar & "Alle filer" & vbNullChar & "*.*" & vbNullChar
    dlg.DialogTitle = "Angiv ny placering af " & ExtractFileName(strFileAndPath) & "..."
    dlg.InitDir = GetBackend
    dlg.ShowOpen
    FindNewFileAndPath = dlg.Filename
    If IsNull(strFileAndPath) Or strFileAndPath = "" Then
        Exit Function
    End If
End Function

Function GetBackend() As String
'  Find stien til backend ved at find den første sammenkædet tabel og kigge på dens .Connect-property
    On Error Resume Next
    Dim tdef As TableDef
    Dim db As Database
    Dim myval
    Set db = CurrentDb
    Set tdef = db.TableDefs(DFirst("Name", "msysobjects", "Type = 6"))
    GetBackend = tdef.connect
    myval = InStr(GetBackend, "DATABASE")
    GetBackend = Mid(GetBackend, myval + 9)
    'MsgBox GetBackend
End Function

Function ExtractFileName(ConnectString As String) As String
    Dim path As String
    path = ConnectString
   
    Do Until Right(path, 1) = "\"
        path = Left(path, Len(path) - 1)
    Loop
    ExtractFileName = Right(ConnectString, Len(ConnectString) - Len(path))
End Function

Function Extractpath(Streng As String) As String
    Do Until Right(Streng, 1) = "\"
        Streng = Left(Streng, Len(Streng) - 1)
    Loop
    Extractpath = Streng
End Function
Avatar billede tigerdyr2007 Praktikant
14. september 2010 - 08:26 #1
Ingen gode bud, jeg lukker
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester