Discussion :

[CIRE3]

Bonjour

Merci d'avance

Je viens de m'apercevoir que dans les fichiers que je reçois tous les jours , certains (pas nombreux) sont protégés et avant que je règle ce problème avec l'expéditeur, je souhaiterai faire l'impasse sur ce fichier et continuer mon importation (et si possible m'indiquer le nom du fichier à problème par box).

Voici mon code d'importation qui fonctionne très bien
il s'arrëte sur la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
DoCmd.TransferDatabase acImport, "dBase IV", "E:\", , NomFich, False, False
 
Voici mon code 
 
Function ImporteDbl1()
 
Dim NomFich As String
Dim StrSQL1 As String, StrSQL2 As String
Dim NomTbl As String
Dim fd As FileDialog, VPathFic As String
Dim Rqa     As String
 
NomFich = Dir("E:*.dbf")
 
 ' tranferer tous les fichiers dbf. de l'emplacement C:/ etc ... Ce qui génére une table nomée 0 dans access puis 1 etc ...
 
Do While NomFich <> ""
 
DoCmd.TransferDatabase acImport, "dBase IV", "E:\", , NomFich, False, False
 
  'executer la requete R_Ajouts_TNT
 
Rqa = "R_Ajouts_TNT"
DoCmd.SetWarnings False
DoCmd.OpenQuery Rqa
 
 
  ' Supprimer la table 0 de la base
 
DoCmd.DeleteObject acTable, "0"
 
 
NomFich = Dir
Loop
 
End Function

[philben]

bonjour,

je pense qu'il y a trois possibilités à gérer :

• TransferDatabase s'exécute normalement :
  -> Exécuter la requete R_Ajouts_TNT.
• TransferDatabase provoque une erreur liée à la protection du fichier :
  -> Continuer la boucle des imports;
  -> Enregistrer le nom du fichier fautif;
  -> NE PAS executer la requete R_Ajouts_TNT pour ce fichier.
• TransferDatabase provoque un autre type d'erreur =>
  -> Proposer à l'utilisateur d'arrêter la boucle des imports;
  -> Enregistrer le nom du fichier fautif;
  -> NE PAS executer la requete R_Ajouts_TNT pour ce fichier.

Le mieux est de placer TransferDatabase dans une fonction à part qui possède un gestionnaire d'erreur et retourne des infos suffisantes à la fonction principale qui adaptera ses actions.

Exemple de fonction appelée par la fonction principale :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Function ImportDbaseIV(ByVal Path As String, ByVal NomFichier As String, ByRef ErreurFichiers As String, ByRef StopImport As Boolean) As Boolean
On Error GoTo catch
Dim sErr As String
DoCmd.TransferDatabase acImport, "dBase IV", Path, , NomFichier, False, False
ImportDbaseIV = True
finally:
Exit Function
catch:
ErreurFichiers = ErreurFichiers & "- " & NomFichier & vbCrLf
If Err.Number <> 999 Then 'Erreur différente du n° d'erreur du à un fichier protégé
sErr = "Une erreur est survenue lors de l'import du fichier '" & NomFichier & "'" & vbCrLf & _
vbTab & "-> Erreur n°" & Err.Number & " (" & Err.Description & ")" & vbCrLf & vbCrLf & _
"Souhaitez-vous poursuivre les importations suivantes ?"
StopImport = (MsgBox(sErr, vbYesNo + vbDefaultButton2 + vbQuestion, "Importation dBase IV...") = vbNo)
End If
Resume finally
End Function

Et l'adaptation de la fonction principale :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Function ImporteDbl1()
Dim NomFich As String
Dim StrSQL1 As String, StrSQL2 As String
Dim NomTbl As String
Dim fd As FileDialog, VPathFic As String
Dim Rqa As String
Dim RapportImports As String, StopImport As Boolean
NomFich = Dir("E:*.dbf")
' tranferer tous les fichiers dbf. de l'emplacement C:/ etc ... Ce qui génére une table nomée 0 dans access puis 1 etc ...
Do While NomFich <> "" And Not StopImport
If ImportDbaseIV("E:\", NomFich, RapportImports, StopImport) Then
'DoCmd.TransferDatabase acImport, "dBase IV", "E:\", , NomFich, False, False
'executer la requete R_Ajouts_TNT
Rqa = "R_Ajouts_TNT"
DoCmd.SetWarnings False
DoCmd.OpenQuery Rqa

' Supprimer la table 0 de la base
DoCmd.DeleteObject acTable, "0"
End If
NomFich = Dir
Loop
If Len(RapportImports) > 0 Then
MsgBox "L'importation a échoué pour les fichiers suivants :" & RapportImports, vbExclamation, "Rapport d'importation"
Else
MsgBox "Tous les fichiers sont importés, Good Job Guy !", vbInformation, "Rapport d'importation"
End If
End Function

En orange : les lignes ajoutées
En rouge : Ligne désactivée


A vérifier car code non testé et à adapter si besoin...

Philippe

[CIRE3]

Bonjour et Merci Philben

malheureusement je ne peux pas essayer le code , en effet , je suis en vacances et les fichiers que j'ai pris ne sont pas protégés hein! hein! et je n'arrive pas à convertir un fichier Dbf en protégé . je garde ta 1 iere solution

Merci pour tout