[AC-2003] Attache de table Access liée à Excel

[alainb]

Bonjour,
J'ai testé ce code d'une discussion de 2007 http://www.developpez.net/forums/d35...che-table-vba/

Mon fichier Excel nommé "maBaseExcel.xls" comporte une zone (de cellules) nommée "base". Il est dans le répertoire courant de ma base Access nommée "liaison.mdb"
J'ai lié la zone "base" à une table (elle prend le nom "table"), puis déplacé le fichier Excel dans un autre répertoire, pour "rompre" l'attache.

Quand je teste la fonction LiaisonTable (CurDir), il ne se passe rien. Je m'attendais à une erreur "Le moteur de base de données Microsoft Jet n'a pas pu trouver la base de données 'maBaseExcel.xls'

Je ne dois pas utiliser correctement la fonction ! Pouvez-vous m'orienter SVP
Alain

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
Function LiaisonTable(pStr_Repertoire) As Integer
Dim LinkTest As Integer
Dim Tabl As DAO.TableDef
 
    DoCmd.Hourglass True
    LiaisonTable = 1
    For Each Tabl In CurrentDb.TableDefs
        If Tabl.Connect <> "" Then
            If Tabl.Name = "base" Then
 
                Tabl.Connect = ";DATABASE=" & pStr_Repertoire & "maBaseExcel.xls"
                On Error Resume Next
                Tabl.RefreshLink
                On Error GoTo 0
            Else
                On Error GoTo Erreur
                Tabl.Connect = ";DATABASE=" & pStr_Repertoire & "maBaseExcel.xls"
                Tabl.RefreshLink
            End If
        End If
    Next
    DoCmd.Hourglass False
    LiaisonTable = 0
    Exit Function
Erreur:
    DoCmd.Hourglass False
    LiaisonTable = 1
End Function

[alainb]

Cette dernière modification est un mélange de solutions proposées dans les forums Access. Cela fonctionne, mais j'ai le sentiment de ne pas avoir codé correctement ...
Après une nouvelle liaison, Tabl.RefreshLink génère une erreur

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Private Sub btn_Click()
 
Dim Tabl As DAO.TableDef
chemin = Application.CurrentProject.Path & "\"
 
    For Each Tabl In CurrentDb.TableDefs
        If Tabl.Connect <> "" Then
            If GetLinkedDBName(Tabl.Name) = chemin & Tabl.Name & ".xls" Then
                Tabl.Connect = ";DATABASE=" & chemin & Tabl.Name & ".xls"
                On Error Resume Next
                Tabl.RefreshLink
                On Error GoTo 0
            Else
 
                Debug.Print "nouvelle liaison"
                DoCmd.DeleteObject acTable, Tabl.Name
                'Puis on importe la table avec le fichier sélectionné
                DoCmd.TransferSpreadsheet acLink, acSpreadsheetTypeExcel9, Tabl.Name, chemin & Tabl.Name & ".xls", True
                'Tabl.RefreshLink
            End If
        End If
    Next
End Sub
 
Function GetLinkedDBName(TableName As String)
 
    Dim db As Database, Ret
    On Error GoTo DBNameErr
    Set db = CurrentDb()
    Ret = db.TableDefs(TableName).Connect
    GetLinkedDBName = Right(Ret, Len(Ret) - (InStr(1, Ret, "DATABASE=") + 8))
    Exit Function
DBNameErr:
    GetLinkedDBName = 0
 
End Function