Newsgroup: it.comp.appl.access
Titolo: riallega tabelle (faq di Karl Donaubauer)

riporto qui di seguito l'interessantissimo codice di Karl per riallegare le
tabelle in modo automatico a patto che il BackEnd stia nella stessa
directory del FrontEnd:
Se sei sicuro, che entrambi i database sono sempre nella stessa directory,
puoi completamente automatizzare il ricollegamento via VBA. Richiama, nella
macro autoexec o nell'evento Su apertura della tua maschera d'avvio, un
codice come segue:
'******* INIZIO CODICE *******
On Error GoTo MyError
Dim db As DAO.Database
Dim strDaten As String
Dim i as Integer
Set db = CurrentDB()
strDaten = Left(db.Name, Len(db.Name) - Len(Dir(db.Name))) & "TuoDato.mdb"
For i = 0 To db.TableDefs.Count - 1
  If db.TableDefs(i).Connect <> "" Then
    If Mid(db.TableDefs(i).Connect, 11) <> strDaten Then
      db.TableDefs(i).Connect = ";database=" & strDaten
      db.TableDefs(i).RefreshLink
    End If
  End If
Next i
MyExit:
  Exit Sub
MyError:
  MsgBox "Un problema è accaduto durante l'installazione. ", 16, "Eccezione"
  Resume MyExit
'******* FINE CODICE *******
a me funziona tutto benissimo ma Vi chiedo .... e se volessi collegarmi a
piu' di un BackEnd, sempre nella stessa dir?
devo aggiungere di seguito a "& "TuoDato.mdb" " ancora un "& "TuoDato2.mdb"
?
Grazie?

 Grazie?
No, la routine di Karl così com'è rimane MonoBE.
Per poter gestire in modo agevole un Relink a MultiBE
la cosa più semplice è crearsi una Tabella Locale(FE)
con l'elenco delle Tabelle da Linkare ed il Path del BE
o meglio il Nome se il percorso completo è quello del FE.
Sostanzialmente 2 campi text:
1) NomeTabella
2) NomeBE
Cicli il recordset aperto sulla tabella e modifichi
la proprietà Connect della Tabella Linkata con il Pecorso.
Ho buttato giù un pò di codice partendo da quello di Karl
e dando per scontato la Tabella sopracitata chiamata "Linked"
******* INIZIO CODICE *******
On Error GoTo MyError
Dim db As DAO.Database
Dim rs as DAO.Recordset
Dim strDaten As String
Set db = CurrentDB()
Set rs = db.Openrecordset("Linked",dbopensnapshot)
rs.Movefirst
strDaten = Left(db.Name, Len(db.Name) - Len(Dir(db.Name))) &
"TuoDato.mdb"
Do until rs.Eof
  If Mid(db.TableDefs(i).Connect, 11) <> strDaten Then
    db.TableDefs(rs!NomeTabella).Connect= ";database=" & strDaten &
rs!Percorso
    db.TableDefs(rs!NomeTabella).RefreshLink
  End If
  rs.Movenext
Loop
MyExit:
  Exit Sub
  rs.close
  set rs=Nothing
  set db=nothing
MyError:
  MsgBox "Un problema è accaduto durante l'installazione. ", 16,
"Eccezione"
  Resume MyExit
'******* FINE CODICE *******
Ciao
@Alex
-- 
Posted via Mailgate.ORG Server - 
http://www.Mailgate.ORG

 ha scritto nel messaggio
news:d667207d580310f4dc...@mygate.mailgate.org...

Ciao Alex, come al solito sei gentilissimo., grazie!

 "TuoDato2.mdb" ?
Puoi usare un Array per essere abbastanza variabile:
'******* INIZIO CODICE *******
On Error GoTo MyError
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strPerc As String, strVec As String
Dim strNomeBE(1) As String
Dim i As Integer
Set db = CurrentDb
strNomeBE(0) = "TuoDato1.mdb"
strNomeBE(1) = "TuoDato2.mdb"
strPerc = Left(db.Name, Len(db.Name) - Len(Dir(db.Name)))
For Each tdf In db.TableDefs
  If tdf.Connect <> "" Then
    strVec = Mid(tdf.Connect, 11)
    For i = 0 To UBound(strNomeBE)
        If InStr(strVec, strNomeBE(i)) > 0 And _
                    strVec <> strPerc & strNomeBE(i) Then
            tdf.Connect = ";database=" & strPerc & strNomeBE(i)
            tdf.RefreshLink
        End If
    Next i
  End If
Next tdf
MyExit:
  Exit Sub
MyError:
  MsgBox "Un problema è accaduto durante l'installazione. ", _
                 vbCritical, "Eccezione"
  Resume MyExit
'******* FINE CODICE *******
Se una volta invece di 2 BE ci sono 3 devi solo cambiare
Dim strNomeBE(1) As String
a
Dim strNomeBE(2) As String
ed aggiungere
strNomeBE(2) = "TuoDato3.mdb"
-- 
HTH
Karl
*********
Access FAQ: 
www.donkarl.com/it
 + iscriviti alla prima Conferenza
Italiana per Sviluppatori di Access (CISA 1), Arezzo, 4+5/6/2005 

 ha scritto nel messaggio
news:3djv05F...@individual.net...

Ok Karl,
molte grazie davvero!