Import puis suppr de table d'erreur xls / mdb

Rhyton le boyar -  
 Rhyton le boyar -
Bonjour,

Je souhaite tester l'existence d'une table sous access avant de la supprimer, de façon à ne pas avoir de message d'erreur.

En fait j'importe des données depuis excel, et ma macro dont vous verrez le code ci dessous vérifie d'abord si le fichier excel est déjà en cours d'utilisation par un autre utilisateur puis, si il est libre, elle efface les données de la table sous access avant de réimporter les données du fichier excel. La macro finissait ensuite en supprimant la table des erreur d'import créée inévitablement.

Ayant fait avec un collègue des modification sur le fichier excel pour que les utilisateur soient obligé de saisir les informations correctement, je n'ai plus de table d'erreur d'import et par conséquent j'ai un message m'indiquant l'impossibilité d'effacer la table d'erreur.

Je souhaiterais donc insérer dans mon code actuel, une autre partie de code testant l'existence de cette table avant de lancer la suppression de table le cas échéant.

Voilà si quelqu'un peut m'aider ça m'arrangerait bien étant encore bien novice dans la programation VB.

Option Compare Database
Function IsOpenable(AFile As String) As Long
Dim FN As Variant
FN = FreeFile
On Error Resume Next
Open AFile For Input Access Read Lock Read Write As #FN
IsOpenable = Err.Number
Close #FN
End Function

Private Sub Command3_Click()
Dim xls As Excel.Application

On Error GoTo errHnd

Select Case IsOpenable("O:\DVO_ALL\03_ACHATS\Dossiers des fournisseurs\Codes.xls")
Case 70: MsgBox "Óæå îòêðûò"
Case 53, 76: MsgBox "Íå îòêðûò, òàê êàê òàêîãî ôàéëà (ïóòè) íåò"
Case 0: 'MsgBox "Íå îòêðûò íèêåì äëÿ çàïèñè. Ìîæíî îòêðûâàòü"
'Set xls = CreateObject("Excel.Application")
'xls.Workbooks.Open "O:\DVO_ALL\03_ACHATS\Dossiers des fournisseurs\Codes.xls"
'xls.Visible = True
' supprime les enregistrement de la table sous access puis réimporte et supprime la table d'erreur
DoCmd.RunMacro "M_UpdateSupplier", 1
Exit Sub
errHnd:
MsgBox "Erreur N° " & Err.Number & vbLf & Err.Description, , Err.Source
Case Else: MsgBox "Déjà ouvert"
End Select
End Sub


ACCESS 2002
A voir également:

1 réponse

Rhyton le boyar
 
c'est bon j'ai enfin trouvé une solution sur un autre post.

Merci quand même au forum,
0