Problemi FE con Tabelle collegate RISOLTO

Question

Ho creato un applicativo con Access 2016, alla fine ho diviso il db creando il BE ed FE, testo il tutto e tt ok. 

Sposto il tutto su un' altro pc (PC2) metto il BE su un server lancio il FE parte la routine per il ricollegamento Tab le ricollego e tutto ok si inizia a lavborare.

Copio il BE ed il FE li rimetto sul computer dove lavoro poichè devo apportare delle modifiche, ed il database all'apertura non va e ritorna sulla maschera principale di access (quella di apri database etc,).

Sembra che non trovi le tabelle e si chiude le ho provate tutte ma non va.

Ho provato ad eliminare la routine che ricollega le tabelle e nemmeno si apre.

Se importo le Tabelle (sul pc2 ) funziona tutto, ma non posso fare questo ogni volta che devo apportare delle modifiche al FE.

Qualcuno potrebbe aiutarmi.

Grazie

Answer 1

Attribute VB_Name = "modVerificaTabelleCollegate"

Option Compare Database

' This code was originally written by Dev Ashish.

' It is not to be altered or distributed,

' except as part of an application.

' You are free to use it in any application,

' provided the copyright notice is left unchanged.

'

' Code Courtesy of

' Dev Ashish

'

Function fRefreshLinks() As Boolean

Dim strMsg As String, collTbls As Collection

Dim i As Integer, strDBPath As String, strTbl As String

Dim dbCurr As Database, dbLink As Database

Dim tdfLocal As TableDef

Dim varRet As Variant

Dim strNewPath As String

Dim boolUnlinkedTables As Boolean

Dim Dummy$

Const cERR_USERCANCEL = vbObjectError + 1000

Const cERR_NOREMOTETABLE = vbObjectError + 2000

    On Local Error GoTo fRefreshLinks_Err

    ' controlliamo prima di proseguire se ci sono tabelle da ricollegare oppure no,

    'in questo caso inutile proseguire!

    boolUnlinkedTables = fUnLinkedTables

    If boolUnlinkedTables = False Then

       fRefreshLinks = True

       Exit Function

    End If

    If MsgBox("Sei sicuro di voler ricollegare tutte le tabelle di Access?", _

            vbQuestion + vbYesNo, "Confermare per favore...") = vbNo Then Err.Raise cERR_USERCANCEL

    'First get all linked tables in a collection

    Set collTbls = fGetLinkedTables

    'now link all of them

    Set dbCurr = CurrentDb

    If boolUnlinkedTables = False Then

        strMsg = "Vuoi selezionare un percorso differente per le tabelle di Access?"

        If MsgBox(strMsg, vbQuestion + vbYesNo, "Origine dati alternativa...") = vbYes Then

            strNewPath = fGetMDBName("Per favore selezionare una nuova origine dati")

        Else

            strNewPath = vbNullString

        End If

    Else

      strNewPath = fGetMDBName("Per favore selezionare una nuova origine dati")

    End If

    For i = collTbls.count To 1 Step -1

        strDBPath = fParsePath(collTbls(i))

        strTbl = fParseTable(collTbls(i))

        varRet = SysCmd(acSysCmdSetStatus, "Sto collegando '" & strTbl & "'....")

        If Left$(strDBPath, 4) = "ODBC" Then

            'ODBC Tables

            'ODBC Tables handled separately

           ' Set tdfLocal = dbCurr.TableDefs(strTbl)

           ' With tdfLocal

           '     .Connect = pcCONNECT

           '     .RefreshLink

           '     collTbls.Remove (strTbl)

           ' End With

        Else

            If strNewPath <> vbNullString Then

                'Try this first

                strDBPath = strNewPath

            Else

                If Len(Dir(strDBPath)) = 0 Then

                    'File Doesn't Exist, call GetOpenFileName

                    strDBPath = fGetMDBName("'" & strDBPath & "' non trovato.")

                    If strDBPath = vbNullString Then

                        'user pressed cancel

                        Err.Raise cERR_USERCANCEL

                    End If

                End If

            End If

            'backend database exists

            'putting it here since we could have

            'tables from multiple sources

            Set dbLink = DBEngine(0).OpenDatabase(strDBPath)

            'check to see if the table is present in dbLink

            strTbl = fParseTable(collTbls(i))

            If fIsRemoteTable(dbLink, strTbl) Then

                'everything's ok, reconnect

                Set tdfLocal = dbCurr.TableDefs(strTbl)

                With tdfLocal

                    .Connect = ";Database=" & strDBPath

                    .RefreshLink

                    collTbls.Remove (.Name)

                End With

            Else

                Err.Raise cERR_NOREMOTETABLE

            End If

        End If

    Next

    fRefreshLinks = True

    varRet = SysCmd(acSysCmdClearStatus)

    MsgBox "Tutte le tabelle sono state ricollegate con successo.", _

            vbInformation + vbOKOnly, _

            "Successo"

   ' impostiamo la proprietà autocompatct

   Application.SetOption "Auto compact", True

   ' eseguiamo il form di avvio!

   On Error Resume Next

   Dummy$ = CurrentDb.Properties("StartupForm")

   If Dummy$ <> "" Then

      DoCmd.OpenForm Dummy$, acNormal

   End If

fRefreshLinks_End:

    Set collTbls = Nothing

    Set tdfLocal = Nothing

    Set dbLink = Nothing

    Set dbCurr = Nothing

    Exit Function

fRefreshLinks_Err:

    fRefreshLinks = False

    Select Case Err

        Case 3059:

        Case cERR_USERCANCEL:

            MsgBox "Non è stato specificato alcun database, impossibile collegare le tabelle.", _

                    vbCritical + vbOKOnly, _

                    "Errore durante l'aggiornamento dei collegamenti."

            Resume fRefreshLinks_End

        Case cERR_NOREMOTETABLE:

            MsgBox "La tabella '" & strTbl & "' non è stata trovata nel database " & _

                    vbCrLf & dbLink.Name & ". Impossibile aggiornare il collegamento", _

                    vbCritical + vbOKOnly, _

                    "Errore durante l'aggiornamento dei collegamenti."

            Resume fRefreshLinks_End

        Case Else:

            strMsg = "Informazione sull'errore..." & vbCrLf & vbCrLf

            strMsg = strMsg & "Function: fRefreshLinks" & vbCrLf

            strMsg = strMsg & "Description: " & Err.description & vbCrLf

            strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf

            MsgBox strMsg, vbOKOnly + vbCritical, "Errore"

            Resume fRefreshLinks_End

    End Select

End Function

Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean

Dim tdf As TableDef

    On Error Resume Next

    Set tdf = dbRemote.TableDefs(strTbl)

    fIsRemoteTable = (Err = 0)

    Set tdf = Nothing

End Function

Function fGetMDBName(strIn As String) As String

'Calls GetOpenFileName dialog

Dim strFilter As String

    strFilter = ahtAddFilterItem(strFilter, _

                    "Access Database(*.mdb;*.accdb;*.mda;*.mde;*.accde;*.mdw) ", _

                    "*.mdb;*.accdb;*.mda; *.mde;*.accde;*.mdw")

    strFilter = ahtAddFilterItem(strFilter, _

                    "All Files (*.*)", _

                    "*.*")

    fGetMDBName = ahtCommonFileOpenSave(Filter:=strFilter, _

                                OpenFile:=True, _

                                DialogTitle:=strIn, _

                                InitialDir:=CurrentProject.path, _

                                Flags:=ahtOFN_HIDEREADONLY)

End Function

Function fGetLinkedTables() As Collection

'Returns all linked tables

    Dim collTables As New Collection

    Dim tdf As TableDef, db As Database

    Set db = CurrentDb

    db.TableDefs.Refresh

    For Each tdf In db.TableDefs

        With tdf

            If tdf.Attributes = dbAttachedTable Then

                If Len(.Connect) > 0 Then

                    If Left$(.Connect, 4) = "ODBC" Then

                    '    collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name

                    'ODBC Reconnect handled separately

                    Else

                        collTables.Add Item:=.Name & .Connect, Key:=.Name

                    End If

                End If

            End If

        End With

    Next

    Set fGetLinkedTables = collTables

    Set collTables = Nothing

    Set tdf = Nothing

    Set db = Nothing

End Function

Function fUnLinkedTables() As Boolean

' scopo: verificare se esiste almeno 1 tabella scollegata!

 Dim tdf As TableDef, db As Database

 On Error GoTo local_errors:

    Set db = CurrentDb

    db.TableDefs.Refresh

    For Each tdf In db.TableDefs

        With tdf

            If tdf.Attributes = dbAttachedTable Then

                If Len(.Connect) > 0 Then

                    If Left$(.Connect, 4) = "ODBC" Then

                    '    collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name

                    'ODBC Reconnect handled separately

                    Else

                        'collTables.Add Item:=.Name & .Connect, Key:=.Name

                       ' proviamo ad aprire la tabella!

                     Dim rst As Recordset

                     Set rst = db.OpenRecordset(tdf.Name, dbOpenDynaset)

                     rst.Close

                    End If

                End If

            End If

        End With

    Next

    Set tdf = Nothing

    Set db = Nothing

   fUnLinkedTables = False

 Exit Function

local_errors:

 fUnLinkedTables = True

End Function

Function fParsePath(strIn As String) As String

    If Left$(strIn, 4) <> "ODBC" Then

        fParsePath = Right(strIn, Len(strIn) _

                        - (InStr(1, strIn, "DATABASE=") + 8))

    Else

        fParsePath = strIn

    End If

End Function

Function fParseTable(strIn As String) As String

    fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)

End Function

Answer 2

Ciao Sandro,

il problema non è che le tabelle non si ricollegano ma che il Db non si apre, anzi tenta di aprirsi per qualche secondo e poi scompare ed access va nella pagina principale.

la routine di relink la escludo dal computer dove funziona (in azienda) e poi mi ricopio il Db.

Se riesco a collegarmi con team viewer copio il modulo di relink e te lo allego.

Grazie

Answer 3

ciao Felice,

scusa ma, non ho capito e/o forse non hai risposto a quanto richiesto.

Il pc sui cui copi il BE e FE, e dal quale vorresti effettuare le modifiche, può accedere alla rete oppure no?

Se no, nel senso che il pc su cui vorresti effettuare le modifiche è quello di casa è ovvio che l'accesso alla base dati ti sia negata e che le tabelle non si ricolleghino perché puntano ad un be che non è accessibile.

Probabilmente la routine non ti mostra errori perché gestisce questo aspetto ed anche altri.

Ho capito male? Come fai ad escludere la routine di collegamento se non riesci ad accedere al FE?

Puoi mostrare la routine di relink?

ciao, Sandro.

Answer 4

Si nella routine più complesse sicuramente Gestiti con goto o resume next.

Penso che ci sia qualche baco strano in questa versione di Access 2016 32 bit (o nel mio pc),

proprio qualche istante fà ho ripreso una copia del db lo diviso e tt ok per testare rinomino il BE e non va, rimetto a posto il BE e funziona, ho fatto lo stesso test in azienda sul server rinominando il BE il DB parte e parte la routine di relink, lo faccio e tutto funziona. In azienda funziona anche su pc che hanno installato solo il runtime di access sia su win7 che su win10.

Ho disinstallato e reinstallato Access pensando a qualche baco di installazione ma nulla,

controllato e ricontrollato tutti i riferimenti, mi sta mandando fuori di testa.

Strano strano.

Dimenticavo, comunque il db l'ho compilato.

Answer 5

Hai messo la gestion errori (on error goto...) in OGNI routine?

Dopo aver verificato, ciò parti dalla prima linea di codice eseguita e avanti passo, passo. È l'unico sistema per scoprire l'errore.