Oprettet søn. d. 29. august 2010 kl. 19:13:29

tigerdyr2007
tigerdyr2007 (7.875 point. Point ude: 0)

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

Skrevet tir. d. 14. september 2010 kl. 08:26:05| #1

tigerdyr2007
tigerdyr2007 (7.875 point)
Ingen gode bud, jeg lukker

Skriv et indlæg




Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] [img]link til billede[/img]
Web- og emailadresser omdannes automatisk til links

Log ind

   

   

Seneste spørgsmål

Link til et dokument

Oprettet den 10. februar 2012 kl. 14.15
omn giver 60 point for svar | Giv et svar »

Formular med flere paramtre

Oprettet den 9. februar 2012 kl. 16.48
stuegnu giver 100 point for svar | Giv et svar »

Kodemodul ???

Oprettet den 8. februar 2012 kl. 17.05
olejohn giver 200 point for svar | Giv et svar »

Seneste guides

Installer win 7
Den gode bruger


   




Tips & Tricks fra PC World

Teaser billede

Her er fem sjove danske websider du skal kende

Trænger dine lattermuskler til en omgang fitness på dansk? Vi viser vej til fem websider fyldt med humor og vanvittig satire.


Anmeldelser fra PC World

Teaser billede

Test: Denne super-tablet er iPads hårdeste konkurrent

Eee Pad Transformer Prime er frygtindgydende med sin quadcore processor og evne til at trylle sig om til bærbar. Apple bør kigge i bagspejlet, for Asus' tablet-pc kommer buldrende - og gør det...


Seneste blogindlæg

Teaser billede

Tvangslukke spørgsmål: Hvad er den bedste løsning?

Hej Vi har mange åbne spørgsmål på Eksperten. Vi ville gerne tvangslukke dem - så et spørgsmål efter f.eks. 6 måneder lukkes. Men der er et par uklarheder som ville være gode at få lidt input til:...


Nyheder fra PC World

Teaser billede

Nu kan du snart hente Windows 8

Den nye offentlige betaversion af Windows 8 er klar i denne måned.


Nyheder fra Computerworld

Teaser billede

Måske snart slut med Androids helt store problem

Android-platformen har længe været plaget af et særligt problem. Men måske er problemet nu ved at være elimineret.


Kurser
Samarbejdspartnere

Udgiver · © 2012 IDG Danmark A/S · Hørkær 18 · 2730 Herlev · Tlf.: 77 300 300 · Fax: 77 300 301 · Brug af personoplysninger