Sub ChangePath()
'Autori: Antonella Romeo & Vincenzo Turturro
'Funzione per effettuare in maniera del tutto automatica
' l'aggiornamento delle tabelle allegate ad un FE, anche quando queste
' sono contenute in pił BE, residenti su percorsi differenti (anche LAN)
' e protetti da password.
' L'unica interazione con l'utente consiste nella richiesta della posizione
' di ogni BE contenente le tabelle da allegare
' La funzione segnala le tabelle allegate al FE non trovate nei BE
' selezionati dall'utente
'Parametri in ingresso: nessuno
'Funzioni richiamate: BrowseFolder() (presente sul sito comune)
    Dim intI As Integer, intJ As Integer, dbs As DAO.Database, tdf As DAO.TableDef, path As String
    Dim sNomeDB As String, intK As Integer, lRefr As Boolean
    Dim tdfNew As DAO.TableDef, dbNew As DAO.Database, stPwd As String, aDB(1 To 50, 1 To 3) As String
    For intI = 1 To UBound(aDB)
      aDB(intI, 1) = ""     ' Nome del database
      aDB(intI, 2) = ""     ' Path del database
      aDB(intI, 3) = ""     ' Password del database
    Next intI
    ' Gestisce il collegamento delle tabelle
    Set dbs = CurrentDb()
    With dbs
      ' Recupera percorso corrente e pwd di ogni mdb contenente le tabelle collegate
      For Each tdf In .TableDefs
        If tdf.Connect > "" Then
           sNomeDB = ""
           ' Ricava il nome del database contenente la tabella
           For intJ = 1 To Len(tdf.Connect)
             If InStr(1, Right$(tdf.Connect, intJ), "\") > 0 Then
                sNomeDB = Mid$(tdf.Connect, Len(tdf.Connect) - intJ + 2)
                If InStr(1, sNomeDB, ";") > 0 Then
                  sNomeDB = Left$(sNomeDB, InStr(1, sNomeDB, ";") - 1)
                End If
                Exit For
             End If
           Next intJ
           For intI = 1 To UBound(aDB)
             If aDB(intI, 1) = sNomeDB Then
                ' Database gią memorizzato nella matrice
                Exit For
             Else
                ' Database non memorizzato nella matrice
                If aDB(intI, 1) = "" Then
                   aDB(intI, 1) = sNomeDB
                   path = Left$(tdf.Connect, InStr(1, tdf.Connect, "\" & sNomeDB) - 1)
                   If InStr(1, path, ":\") > 0 Then
                      ' Percorso su unitą logica
                      path = Mid$(path, InStr(1, path, ":\") - 1)
                   Else
                      ' Percorso UNC
                      If InStr(1, path, "\\") > 0 Then
                         path = Mid$(path, InStr(1, path, "\\"))
                      End If
                   End If
                   aDB(intI, 2) = path
                   stPwd = ""
                   If InStr(1, tdf.Connect, ";PWD=") > 0 Then
                      stPwd = Mid$(tdf.Connect, InStr(1, tdf.Connect, ";PWD="))
                      stPwd = Left$(stPwd, IIf(InStr(2, stPwd, ";") > 0, InStr(2, stPwd, ";") - 1, Len(stPwd)))
                   End If
                   aDB(intI, 3) = stPwd
                   Exit For
                End If
             End If
           Next intI
        End If
      Next tdf
    End With
    For intI = 1 To UBound(aDB)
      If aDB(intI, 1) > "" Then
         path = BrowseFolder("Percorso corrente: " & aDB(intI, 2) & "\" & aDB(intI, 1))
         If Nz(path, "") > "" Then
            If Dir(path & "\" & aDB(intI, 1)) > "" Then
               path = Trim$(path)
               If Right$(path, 1) = "\" Then
                  path = Left$(path, Len(path) - 1)
               End If
               aDB(intI, 2) = path
            Else
               MsgBox "La cartella selezionata non contiene il database " & aDB(intI, 1), vbCritical
               intI = intI - 1
            End If
         End If
      Else
         Exit For
      End If
    Next intI
    ' Aggiorna i collegamenti
    DoCmd.Hourglass True
    With dbs
      ' Scorre l'insieme TableDefs
      For Each tdf In .TableDefs
        lRefr = False
        sNomeDB = ""
        If tdf.Connect > "" Then
           ' Ricava il nome del database contenente la tabella
           For intJ = 1 To Len(tdf.Connect)
             If InStr(1, Right$(tdf.Connect, intJ), "\") > 0 Then
                sNomeDB = Mid$(tdf.Connect, Len(tdf.Connect) - intJ + 2)
                If InStr(1, sNomeDB, ";") > 0 Then
                   sNomeDB = Left$(sNomeDB, InStr(1, sNomeDB, ";") - 1)
                End If
                Exit For
             End If
           Next intJ
           For intK = 1 To UBound(aDB)
             If Trim$(aDB(intK, 1)) = Trim$(sNomeDB) Then
                ' ... cerca la tabella nel nuovo database
                Set dbNew = OpenDatabase(aDB(intK, 2) & "\" & aDB(intK, 1), False, False, aDB(intK, 3))
                With dbNew
                  For Each tdfNew In .TableDefs
                    If tdfNew.name = tdf.name Then
                       ' ... modifica il percorso del database contenente la tabella
                        tdf.Connect = Left$(tdf.Connect, IIf(InStr(1, tdf.Connect, ":") > 0, _
                           InStr(1, tdf.Connect, ":") - 2, InStr(1, tdf.Connect, "\\") - 1)) & _
                           Trim$(aDB(intK, 2)) & "\" & aDB(intK, 1) & _
                           Mid$(tdf.Connect, InStr(1, tdf.Connect, sNomeDB) + Len(Trim$(sNomeDB)))
                       tdf.RefreshLink
                       lRefr = True
                       Exit For
                    End If
                  Next tdfNew
                End With
                dbNew.Close
                Set dbNew = Nothing
                Exit For
             End If
           Next intK
           If Not lRefr Then
              MsgBox "Tabella " & tdf.name & " non trovata nel database"
           End If
        End If
      Next tdf
    End With
    DoCmd.Hourglass False
End Sub