Tables |
1.10 Effettuare in maniera del tutto automatica l'aggiornamento delle tabelle allegate ad un FE. |
Vincenzo Turturro |
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 SubNOTA La sub di cui sopra fa riferimento alla libreria Microsoft DAO quindi, se si usa una versione di Acess successiva ad Access 97, è necessario aggiungere al database i riferimenti a Microsoft DAO 3.6 Object Library. |