Base ACCESS 2010 fractionnée et liaison UNC

Sub MAJ()  
Dim Db As Database  
Dim Tb As TableDef  
Dim Unc As String  
Dim Rep As Integer  
Dim Fd As FileDialog  
Dim SelectedFile As Variant  
Dim NomBase As String  
' Ouverture d'une boite de dialogue pour choix de la base à lier  
Set Fd = FileDialog(msoFileDialogOpen)  
With Fd  
    .AllowMultiSelect = False  
    .ButtonName = "Ouvrir"  
    .Filters.Clear  
    .Filters.Add "Bases Access", "*.mdb"  
    .InitialFileName = "*.mdb"  
    .InitialView = msoFileDialogViewList  
    .Title = "sélectionnez un fichier"  
    If .Show Then  
        For Each SelectedFile In .SelectedItems  
            NomBase = SelectedFile  
        Next SelectedFile  
    End If  
End With  
Set Fd = Nothing  
' Mise à jour des attaches  
Set Db = CurrentDb  
Unc = ";DATABASE=" & NomBase  
' Test des attachements  
' On exclut les tables système  
' ainsi que les tables non attachées  
For Each Tb In Db.TableDefs  
    If Left(Tb.Name, 4) <> "MSys" And Tb.Connect <> "" Then  
        MsgBox "Table :" & Tb.Name & vbCrLf & "actuellement attachée à" & vbCrLf & "Chemin : " & Tb.Connect  
        Rep = MsgBox("Mettre à jour la table " & Tb.Name & vbCrLf & "pour pointer sur " & Unc & " ?", vbYesNo, "Confirmation...")  
        If Rep = vbYes Then  
            Tb.Connect = Unc  
            Tb.RefreshLink  
        End If  
    End If  
Next  
Set Db = Nothing  
End Sub 

Private Sub Commande10_Click()  
MAJ  
End Sub  

 "Les cons, ça ose tout.  
C'est même à ça qu'on les reconnait"

Sub MAJ()
Dim Db As Database
Dim Tb As TableDef
Dim Unc As String
Dim Rep As Integer
Dim Fd As FileDialog
Dim SelectedFile As Variant
Dim NomBase As String
' Ouverture d'une boite de dialogue pour choix de la base à lier
Set Fd = FileDialog(msoFileDialogOpen)
With Fd
    .AllowMultiSelect = False
    .ButtonName = "Ouvrir"
    .Filters.Clear
    .Filters.Add "Bases Access", "*.mdb"
    .InitialFileName = "*.mdb"
    .InitialView = msoFileDialogViewList
    .Title = "sélectionnez un fichier"
    If .Show Then
        For Each SelectedFile In .SelectedItems
            NomBase = SelectedFile
        Next SelectedFile
    End If
End With
Set Fd = Nothing
If NomBase <> "" Then
    Rep = MsgBox("Mettre à jour les attaches de la base" & vbCrLf & "pour pointer sur " & NomBase & " ?", vbYesNo, "Confirmation...")
    If Rep = vbYes Then
        Set Db = CurrentDb
        Unc = ";DATABASE=" & NomBase
        ' Test des attachements
        ' On exclut les tables système
        ' ainsi que les tables non attachées
        For Each Tb In Db.TableDefs
            If Left(Tb.Name, 4) <> "MSys" And Tb.Connect <> "" Then
                Tb.Connect = Unc
                Tb.RefreshLink
            End If
        Next
        Set Db = Nothing
    End If
End If
End Sub

 "Les cons, ça ose tout. 
C'est même à ça qu'on les reconnait"