Merci Raymond, mais je ne sais pas de quoi tu parles, la réponse de
jadis ne m'avait pas été donnée par toi.
Voilà le code qu'on m'a donné. Ca plante sur Currentdbdir() (fonction
non définie)
Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef
Dim varRet As Variant
Dim strNewPath As String
'If MsgBox("Are you sure you want to reconnect all Access tables?", _
vbQuestion + vbYesNo, "Please confirm...") = vbNo Then
Err.RaisecERR_USERCANCEL
'Premièrement, trouver toutes les tables liées, dans la collection
Set collTbls = fGetLinkedTables
'et maintenant, les relier
Set dbCurr = CurrentDb
For i = collTbls.Count To 1 Step -1
strDBPath = fParsePath(collTbls(i))
strTbl = fParseTable(collTbls(i))
If Right(strTbl, 4) = "Text" Then
ConnectText strTbl
GoTo imi
End If
varRet = SysCmd(acSysCmdSetStatus, "Liaison de '" & strTbl &
"'....")
If Left$(strDBPath, 4) = "ODBC" Then
'Tables ODBC
'les tables ODBC sont manipulées différemment
' Set tdfLocal = dbCurr.TableDefs(strTbl)
' With tdfLocal
' .Connect = pcCONNECT
' .RefreshLink
' collTbls.Remove (strTbl)
' End With
Else
If strNewPath <> vbNullString Then
'Essayer ceci en premier
strDBPath = strNewPath
Else
'If Len(Dir(strDBPath)) = 0 Then
'Le fichier n'existe pas, appeler GetOpenFileName
strDBPath = CurrentDBDir() & "data_aubry_2.mdb"
If strDBPath = vbNullString Then
'L'utilisateur annule en cliquant cancel
Err.Raise cERR_USERCANCEL
End If
'End If
End If
'la base de données d'arrière-plan existe
'On place ici, car on peut avoir plusieurs sources
'différentes
Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
'vérifier si la table est présente dans dbLink
strTbl = fParseTable(collTbls(i))
If fIsRemoteTable(dbLink, strTbl) Then
'tout est beau, on reconnecte
Set tdfLocal = dbCurr.TableDefs(strTbl)
With tdfLocal
.Connect = ";Database=" & strDBPath
.RefreshLink
collTbls.Remove (.Name)
End With
Else
Err.Raise cERR_NOREMOTETABLE
End If
End If
imi:
Next
fRefreshLinks = True
varRet = SysCmd(acSysCmdClearStatus)
'MsgBox "Toutes les tables Access sont reconnectées avec succès.",
vbInformation + vbOKOnly, "Succès"
fRefreshLinks_End:
Set collTbls = Nothing
Set tdfLocal = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case Err
Case 3059:
Case cERR_USERCANCEL:
MsgBox "Aucune base de données n'est spécifiée, ne peut
reconnecter les tables.", _
vbCritical + vbOKOnly, _
"Erreur en rafraîchissant les liens."
Resume fRefreshLinks_End
Case cERR_NOREMOTETABLE:
MsgBox "La table '" & strTbl & "' n'est pas trouvée dans la
base de données " & _
vbCrLf & dbLink.Name & ". On ne peut rafraîchir le
lien", _
vbCritical + vbOKOnly, _
"Erreur en rafraîchissant les liens."
Resume fRefreshLinks_End
Case Else:
strMsg = "Erreur..." & vbCrLf & vbCrLf
strMsg = strMsg & "Connection à la base" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
'strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Erreur"
Resume fRefreshLinks_End
End Select
End Function
Function fGetLinkedTables() As Collection
'Retourne toutes les tables liées
Dim collTables As New Collection
Dim tdf As TableDef, db As Database
Set db = CurrentDb
db.TableDefs.Refresh
For Each tdf In db.TableDefs
With tdf
If Len(.Connect) > 0 Then
'If Left$(.Connect, 4) = "ODBC" Then
' collTables.Add Item:=.Name & ";" & .Connect,
KEY:=.Name
'ODBC Reconnect handled separately
'Else
collTables.Add Item:=.Name & .Connect, Key:=.Name
'End If
End If
End With
Next
Set fGetLinkedTables = collTables
Set collTables = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
Function fParsePath(strIn As String) As String
If Left$(strIn, 4) <> "ODBC" Then
fParsePath = Right(strIn, Len(strIn) _
- (InStr(1, strIn, "DATABASE=") + 8))
Else
fParsePath = strIn
End If
End Function
Function fParseTable(strIn As String) As String
fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
End Function
Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
Dim tdf As TableDef
On Error Resume Next
Set tdf = dbRemote.TableDefs(strTbl)
fIsRemoteTable = (Err = 0)
Set tdf = Nothing
End Function
Sub ConnectText(Qui)
Dim tdfLinked As TableDef
Dim bd As Database
Dim T As String
Set bd = CurrentDb
T = Left(Qui, Len(Qui) - 5)
On Error Resume Next
bd.TableDefs.Delete T & "2"
On Error GoTo 0
On Error GoTo c_err
Set tdfLinked = bd.CreateTableDef(T & "2")
tdfLinked.Connect = "Text;DATABASE=" & CurrentDBDir()
tdfLinked.SourceTableName = T & ".txt"
bd.TableDefs.Append tdfLinked
Set bd = Nothing
bye_c_err:
Exit Sub
c_err:
MsgBox Error$
Resume bye_c_err
End Sub
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Raymond [mvp]
où est-ce que tu as pris toutes ces pages dont la moitié ne servent pas en temps normal.
je te conseille de faire simple, en regardant les pages: http://officesystem.access.free.fr/vba/verifierliens.htm et http://users.skynet.be/accesshome/tables.htm#Links -- @+ Raymond Access MVP http://OfficeSystem.Access.free.fr/ http://OfficeSystem.Access.free.fr/runtime/ http://users.skynet.be/mpfa/ pour débuter sur le forum
"Jean" a écrit dans le message de news: cud7s2$ous$
Merci Raymond, mais je ne sais pas de quoi tu parles, la réponse de jadis ne m'avait pas été donnée par toi.
Voilà le code qu'on m'a donné. Ca plante sur Currentdbdir() (fonction non définie)
Function fRefreshLinks() As Boolean Dim strMsg As String, collTbls As Collection Dim i As Integer, strDBPath As String, strTbl As String Dim dbCurr As Database, dbLink As Database Dim tdfLocal As TableDef Dim varRet As Variant Dim strNewPath As String
'If MsgBox("Are you sure you want to reconnect all Access tables?", _ vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.RaisecERR_USERCANCEL
'Premièrement, trouver toutes les tables liées, dans la collection Set collTbls = fGetLinkedTables
'et maintenant, les relier Set dbCurr = CurrentDb
For i = collTbls.Count To 1 Step -1 strDBPath = fParsePath(collTbls(i)) strTbl = fParseTable(collTbls(i)) If Right(strTbl, 4) = "Text" Then ConnectText strTbl GoTo imi End If varRet = SysCmd(acSysCmdSetStatus, "Liaison de '" & strTbl & "'....") If Left$(strDBPath, 4) = "ODBC" Then 'Tables ODBC 'les tables ODBC sont manipulées différemment ' Set tdfLocal = dbCurr.TableDefs(strTbl) ' With tdfLocal ' .Connect = pcCONNECT ' .RefreshLink ' collTbls.Remove (strTbl) ' End With Else If strNewPath <> vbNullString Then 'Essayer ceci en premier strDBPath = strNewPath Else 'If Len(Dir(strDBPath)) = 0 Then 'Le fichier n'existe pas, appeler GetOpenFileName strDBPath = CurrentDBDir() & "data_aubry_2.mdb"
If strDBPath = vbNullString Then 'L'utilisateur annule en cliquant cancel Err.Raise cERR_USERCANCEL End If 'End If End If
'la base de données d'arrière-plan existe 'On place ici, car on peut avoir plusieurs sources 'différentes Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
'vérifier si la table est présente dans dbLink strTbl = fParseTable(collTbls(i)) If fIsRemoteTable(dbLink, strTbl) Then 'tout est beau, on reconnecte Set tdfLocal = dbCurr.TableDefs(strTbl) With tdfLocal .Connect = ";Database=" & strDBPath .RefreshLink collTbls.Remove (.Name) End With Else Err.Raise cERR_NOREMOTETABLE End If End If imi: Next fRefreshLinks = True varRet = SysCmd(acSysCmdClearStatus) 'MsgBox "Toutes les tables Access sont reconnectées avec succès.", vbInformation + vbOKOnly, "Succès" fRefreshLinks_End: Set collTbls = Nothing Set tdfLocal = Nothing Set dbLink = Nothing Set dbCurr = Nothing Exit Function fRefreshLinks_Err: fRefreshLinks = False Select Case Err Case 3059:
Case cERR_USERCANCEL: MsgBox "Aucune base de données n'est spécifiée, ne peut reconnecter les tables.", _ vbCritical + vbOKOnly, _ "Erreur en rafraîchissant les liens." Resume fRefreshLinks_End Case cERR_NOREMOTETABLE: MsgBox "La table '" & strTbl & "' n'est pas trouvée dans la base de données " & _ vbCrLf & dbLink.Name & ". On ne peut rafraîchir le lien", _ vbCritical + vbOKOnly, _ "Erreur en rafraîchissant les liens." Resume fRefreshLinks_End Case Else: strMsg = "Erreur..." & vbCrLf & vbCrLf strMsg = strMsg & "Connection à la base" & vbCrLf strMsg = strMsg & "Description: " & Err.Description & vbCrLf 'strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf MsgBox strMsg, vbOKOnly + vbCritical, "Erreur" Resume fRefreshLinks_End End Select End Function
Function fGetLinkedTables() As Collection 'Retourne toutes les tables liées Dim collTables As New Collection Dim tdf As TableDef, db As Database Set db = CurrentDb db.TableDefs.Refresh For Each tdf In db.TableDefs With tdf If Len(.Connect) > 0 Then 'If Left$(.Connect, 4) = "ODBC" Then ' collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name 'ODBC Reconnect handled separately 'Else collTables.Add Item:=.Name & .Connect, Key:=.Name 'End If End If End With Next Set fGetLinkedTables = collTables Set collTables = Nothing Set tdf = Nothing Set db = Nothing End Function Function fParsePath(strIn As String) As String If Left$(strIn, 4) <> "ODBC" Then fParsePath = Right(strIn, Len(strIn) _ - (InStr(1, strIn, "DATABASE=") + 8)) Else fParsePath = strIn End If End Function
Function fParseTable(strIn As String) As String fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1) End Function
Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean Dim tdf As TableDef On Error Resume Next Set tdf = dbRemote.TableDefs(strTbl) fIsRemoteTable = (Err = 0) Set tdf = Nothing End Function Sub ConnectText(Qui) Dim tdfLinked As TableDef Dim bd As Database Dim T As String Set bd = CurrentDb T = Left(Qui, Len(Qui) - 5) On Error Resume Next bd.TableDefs.Delete T & "2" On Error GoTo 0 On Error GoTo c_err Set tdfLinked = bd.CreateTableDef(T & "2")
tdfLinked.Connect = "Text;DATABASE=" & CurrentDBDir() tdfLinked.SourceTableName = T & ".txt"
bd.TableDefs.Append tdfLinked Set bd = Nothing bye_c_err: Exit Sub c_err: MsgBox Error$ Resume bye_c_err End Sub
où est-ce que tu as pris toutes ces pages dont la moitié ne servent pas en
temps normal.
je te conseille de faire simple, en regardant les pages:
http://officesystem.access.free.fr/vba/verifierliens.htm
et
http://users.skynet.be/accesshome/tables.htm#Links
--
@+
Raymond Access MVP
http://OfficeSystem.Access.free.fr/
http://OfficeSystem.Access.free.fr/runtime/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"Jean" <jorlandi@9online.fr> a écrit dans le message de news:
cud7s2$ous$1@aphrodite.grec.isp.9tel.net...
Merci Raymond, mais je ne sais pas de quoi tu parles, la réponse de jadis
ne m'avait pas été donnée par toi.
Voilà le code qu'on m'a donné. Ca plante sur Currentdbdir() (fonction non
définie)
Function fRefreshLinks() As Boolean
Dim strMsg As String, collTbls As Collection
Dim i As Integer, strDBPath As String, strTbl As String
Dim dbCurr As Database, dbLink As Database
Dim tdfLocal As TableDef
Dim varRet As Variant
Dim strNewPath As String
'If MsgBox("Are you sure you want to reconnect all Access tables?", _
vbQuestion + vbYesNo, "Please confirm...") = vbNo Then
Err.RaisecERR_USERCANCEL
'Premièrement, trouver toutes les tables liées, dans la collection
Set collTbls = fGetLinkedTables
'et maintenant, les relier
Set dbCurr = CurrentDb
For i = collTbls.Count To 1 Step -1
strDBPath = fParsePath(collTbls(i))
strTbl = fParseTable(collTbls(i))
If Right(strTbl, 4) = "Text" Then
ConnectText strTbl
GoTo imi
End If
varRet = SysCmd(acSysCmdSetStatus, "Liaison de '" & strTbl &
"'....")
If Left$(strDBPath, 4) = "ODBC" Then
'Tables ODBC
'les tables ODBC sont manipulées différemment
' Set tdfLocal = dbCurr.TableDefs(strTbl)
' With tdfLocal
' .Connect = pcCONNECT
' .RefreshLink
' collTbls.Remove (strTbl)
' End With
Else
If strNewPath <> vbNullString Then
'Essayer ceci en premier
strDBPath = strNewPath
Else
'If Len(Dir(strDBPath)) = 0 Then
'Le fichier n'existe pas, appeler GetOpenFileName
strDBPath = CurrentDBDir() & "data_aubry_2.mdb"
If strDBPath = vbNullString Then
'L'utilisateur annule en cliquant cancel
Err.Raise cERR_USERCANCEL
End If
'End If
End If
'la base de données d'arrière-plan existe
'On place ici, car on peut avoir plusieurs sources
'différentes
Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
'vérifier si la table est présente dans dbLink
strTbl = fParseTable(collTbls(i))
If fIsRemoteTable(dbLink, strTbl) Then
'tout est beau, on reconnecte
Set tdfLocal = dbCurr.TableDefs(strTbl)
With tdfLocal
.Connect = ";Database=" & strDBPath
.RefreshLink
collTbls.Remove (.Name)
End With
Else
Err.Raise cERR_NOREMOTETABLE
End If
End If
imi:
Next
fRefreshLinks = True
varRet = SysCmd(acSysCmdClearStatus)
'MsgBox "Toutes les tables Access sont reconnectées avec succès.",
vbInformation + vbOKOnly, "Succès"
fRefreshLinks_End:
Set collTbls = Nothing
Set tdfLocal = Nothing
Set dbLink = Nothing
Set dbCurr = Nothing
Exit Function
fRefreshLinks_Err:
fRefreshLinks = False
Select Case Err
Case 3059:
Case cERR_USERCANCEL:
MsgBox "Aucune base de données n'est spécifiée, ne peut
reconnecter les tables.", _
vbCritical + vbOKOnly, _
"Erreur en rafraîchissant les liens."
Resume fRefreshLinks_End
Case cERR_NOREMOTETABLE:
MsgBox "La table '" & strTbl & "' n'est pas trouvée dans la
base de données " & _
vbCrLf & dbLink.Name & ". On ne peut rafraîchir le
lien", _
vbCritical + vbOKOnly, _
"Erreur en rafraîchissant les liens."
Resume fRefreshLinks_End
Case Else:
strMsg = "Erreur..." & vbCrLf & vbCrLf
strMsg = strMsg & "Connection à la base" & vbCrLf
strMsg = strMsg & "Description: " & Err.Description & vbCrLf
'strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf
MsgBox strMsg, vbOKOnly + vbCritical, "Erreur"
Resume fRefreshLinks_End
End Select
End Function
Function fGetLinkedTables() As Collection
'Retourne toutes les tables liées
Dim collTables As New Collection
Dim tdf As TableDef, db As Database
Set db = CurrentDb
db.TableDefs.Refresh
For Each tdf In db.TableDefs
With tdf
If Len(.Connect) > 0 Then
'If Left$(.Connect, 4) = "ODBC" Then
' collTables.Add Item:=.Name & ";" & .Connect,
KEY:=.Name
'ODBC Reconnect handled separately
'Else
collTables.Add Item:=.Name & .Connect, Key:=.Name
'End If
End If
End With
Next
Set fGetLinkedTables = collTables
Set collTables = Nothing
Set tdf = Nothing
Set db = Nothing
End Function
Function fParsePath(strIn As String) As String
If Left$(strIn, 4) <> "ODBC" Then
fParsePath = Right(strIn, Len(strIn) _
- (InStr(1, strIn, "DATABASE=") + 8))
Else
fParsePath = strIn
End If
End Function
Function fParseTable(strIn As String) As String
fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1)
End Function
Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean
Dim tdf As TableDef
On Error Resume Next
Set tdf = dbRemote.TableDefs(strTbl)
fIsRemoteTable = (Err = 0)
Set tdf = Nothing
End Function
Sub ConnectText(Qui)
Dim tdfLinked As TableDef
Dim bd As Database
Dim T As String
Set bd = CurrentDb
T = Left(Qui, Len(Qui) - 5)
On Error Resume Next
bd.TableDefs.Delete T & "2"
On Error GoTo 0
On Error GoTo c_err
Set tdfLinked = bd.CreateTableDef(T & "2")
tdfLinked.Connect = "Text;DATABASE=" & CurrentDBDir()
tdfLinked.SourceTableName = T & ".txt"
bd.TableDefs.Append tdfLinked
Set bd = Nothing
bye_c_err:
Exit Sub
c_err:
MsgBox Error$
Resume bye_c_err
End Sub
où est-ce que tu as pris toutes ces pages dont la moitié ne servent pas en temps normal.
je te conseille de faire simple, en regardant les pages: http://officesystem.access.free.fr/vba/verifierliens.htm et http://users.skynet.be/accesshome/tables.htm#Links -- @+ Raymond Access MVP http://OfficeSystem.Access.free.fr/ http://OfficeSystem.Access.free.fr/runtime/ http://users.skynet.be/mpfa/ pour débuter sur le forum
"Jean" a écrit dans le message de news: cud7s2$ous$
Merci Raymond, mais je ne sais pas de quoi tu parles, la réponse de jadis ne m'avait pas été donnée par toi.
Voilà le code qu'on m'a donné. Ca plante sur Currentdbdir() (fonction non définie)
Function fRefreshLinks() As Boolean Dim strMsg As String, collTbls As Collection Dim i As Integer, strDBPath As String, strTbl As String Dim dbCurr As Database, dbLink As Database Dim tdfLocal As TableDef Dim varRet As Variant Dim strNewPath As String
'If MsgBox("Are you sure you want to reconnect all Access tables?", _ vbQuestion + vbYesNo, "Please confirm...") = vbNo Then Err.RaisecERR_USERCANCEL
'Premièrement, trouver toutes les tables liées, dans la collection Set collTbls = fGetLinkedTables
'et maintenant, les relier Set dbCurr = CurrentDb
For i = collTbls.Count To 1 Step -1 strDBPath = fParsePath(collTbls(i)) strTbl = fParseTable(collTbls(i)) If Right(strTbl, 4) = "Text" Then ConnectText strTbl GoTo imi End If varRet = SysCmd(acSysCmdSetStatus, "Liaison de '" & strTbl & "'....") If Left$(strDBPath, 4) = "ODBC" Then 'Tables ODBC 'les tables ODBC sont manipulées différemment ' Set tdfLocal = dbCurr.TableDefs(strTbl) ' With tdfLocal ' .Connect = pcCONNECT ' .RefreshLink ' collTbls.Remove (strTbl) ' End With Else If strNewPath <> vbNullString Then 'Essayer ceci en premier strDBPath = strNewPath Else 'If Len(Dir(strDBPath)) = 0 Then 'Le fichier n'existe pas, appeler GetOpenFileName strDBPath = CurrentDBDir() & "data_aubry_2.mdb"
If strDBPath = vbNullString Then 'L'utilisateur annule en cliquant cancel Err.Raise cERR_USERCANCEL End If 'End If End If
'la base de données d'arrière-plan existe 'On place ici, car on peut avoir plusieurs sources 'différentes Set dbLink = DBEngine(0).OpenDatabase(strDBPath)
'vérifier si la table est présente dans dbLink strTbl = fParseTable(collTbls(i)) If fIsRemoteTable(dbLink, strTbl) Then 'tout est beau, on reconnecte Set tdfLocal = dbCurr.TableDefs(strTbl) With tdfLocal .Connect = ";Database=" & strDBPath .RefreshLink collTbls.Remove (.Name) End With Else Err.Raise cERR_NOREMOTETABLE End If End If imi: Next fRefreshLinks = True varRet = SysCmd(acSysCmdClearStatus) 'MsgBox "Toutes les tables Access sont reconnectées avec succès.", vbInformation + vbOKOnly, "Succès" fRefreshLinks_End: Set collTbls = Nothing Set tdfLocal = Nothing Set dbLink = Nothing Set dbCurr = Nothing Exit Function fRefreshLinks_Err: fRefreshLinks = False Select Case Err Case 3059:
Case cERR_USERCANCEL: MsgBox "Aucune base de données n'est spécifiée, ne peut reconnecter les tables.", _ vbCritical + vbOKOnly, _ "Erreur en rafraîchissant les liens." Resume fRefreshLinks_End Case cERR_NOREMOTETABLE: MsgBox "La table '" & strTbl & "' n'est pas trouvée dans la base de données " & _ vbCrLf & dbLink.Name & ". On ne peut rafraîchir le lien", _ vbCritical + vbOKOnly, _ "Erreur en rafraîchissant les liens." Resume fRefreshLinks_End Case Else: strMsg = "Erreur..." & vbCrLf & vbCrLf strMsg = strMsg & "Connection à la base" & vbCrLf strMsg = strMsg & "Description: " & Err.Description & vbCrLf 'strMsg = strMsg & "Error #: " & Format$(Err.Number) & vbCrLf MsgBox strMsg, vbOKOnly + vbCritical, "Erreur" Resume fRefreshLinks_End End Select End Function
Function fGetLinkedTables() As Collection 'Retourne toutes les tables liées Dim collTables As New Collection Dim tdf As TableDef, db As Database Set db = CurrentDb db.TableDefs.Refresh For Each tdf In db.TableDefs With tdf If Len(.Connect) > 0 Then 'If Left$(.Connect, 4) = "ODBC" Then ' collTables.Add Item:=.Name & ";" & .Connect, KEY:=.Name 'ODBC Reconnect handled separately 'Else collTables.Add Item:=.Name & .Connect, Key:=.Name 'End If End If End With Next Set fGetLinkedTables = collTables Set collTables = Nothing Set tdf = Nothing Set db = Nothing End Function Function fParsePath(strIn As String) As String If Left$(strIn, 4) <> "ODBC" Then fParsePath = Right(strIn, Len(strIn) _ - (InStr(1, strIn, "DATABASE=") + 8)) Else fParsePath = strIn End If End Function
Function fParseTable(strIn As String) As String fParseTable = Left$(strIn, InStr(1, strIn, ";") - 1) End Function
Function fIsRemoteTable(dbRemote As Database, strTbl As String) As Boolean Dim tdf As TableDef On Error Resume Next Set tdf = dbRemote.TableDefs(strTbl) fIsRemoteTable = (Err = 0) Set tdf = Nothing End Function Sub ConnectText(Qui) Dim tdfLinked As TableDef Dim bd As Database Dim T As String Set bd = CurrentDb T = Left(Qui, Len(Qui) - 5) On Error Resume Next bd.TableDefs.Delete T & "2" On Error GoTo 0 On Error GoTo c_err Set tdfLinked = bd.CreateTableDef(T & "2")
tdfLinked.Connect = "Text;DATABASE=" & CurrentDBDir() tdfLinked.SourceTableName = T & ".txt"
bd.TableDefs.Append tdfLinked Set bd = Nothing bye_c_err: Exit Sub c_err: MsgBox Error$ Resume bye_c_err End Sub