Erreur "1004" même avec Gestion d'Erreur

[jfraynau]

Bonjour, je n'arrive pas a gerer une erreur de type 1004 sous xlsVBA.
La 1er fois l'erreur est bien gerée la seconde fois il me renvoi la boite de dialogue 'Debogage'
Pourriez vous m'aider? .



On Error GoTo FichierATS
Path(1) = InputBox('Chemin/Path ou se trouve le(s) fichier(s):', 'DIRECTORY', 'U:\\')
ExtractionATS:
Fichier(1) = InputBox('Nom du Fichier ATS:', 'Extraction ATS', 'ats')

Workbooks.OpenText Filename:=Path(1) & Fichier(1) & '.prn', Origin:=xlWindows….

On Error GoTo AutreErreur

LA MACRO CONTINUE…………….

NouvelleExtractionATS:
Msg = 'Voulez vous formater un autre fichier ATS ?' ' Définit le message.
Style = vbYesNo + vbInformation + vbDefaultButton2 ' Définit les boutons.
Title = 'EXTRACTION Suite...' ' Définit le titre.

Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
GoTo ExtractionATS
End If


ExtractionWIP:
Fichier(2) = InputBox('Veuillez indiquer le nom de' & Chr(13) & 'votre fichier', 'NOM DU FICHIER', 'wip')

On Error GoTo FichierWIP
Workbooks.OpenText Filename:=Path(1) & Fichier(2) & '.prn', Origin:=xlWindows…….

On Error GoTo AutreErreur

LA MACRO CONTINUE…….

Msg = 'Voulez vous formater un autre fichier WIP ?' ' Définit le message.
Style = vbYesNo + vbInformation + vbDefaultButton2 ' Définit les boutons.
Title = 'EXTRACTION Suite...' ' Définit le titre.

NouvelleExtractionWIP:
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
GoTo ExtractionWIP
End If

Msg = 'Voulez vous formater le fichier Expedition ?' ' Définit le message.
Style = vbYesNo + vbInformation + vbDefaultButton1 ' Définit les boutons.
Title = 'EXTRACTION Suite...' ' Définit le titre.

Fichier71518:
Response = MsgBox(Msg, Style, Title, Help, Ctxt)
If Response = vbYes Then ' L'utilisateur a choisi Oui.
Call FormatExpedition
End If

………….

EXIT SUB
'=====================GESTION DES ERREURS=========================================

NoProblemo:
MsgBox 'Extraction Terminée'
Exit Sub

FichierWIP:
MsgBox 'Le Fichier est vide ou inexistant', vbCritical, 'ERREUR EXTRACTION'
On Error Resume Next
GoTo NouvelleExtractionWIP

FichierATS:
MsgBox 'Le Fichier est vide ou inexistant' & Chr(13) & 'Extraction Suivante...', vbCritical, 'ERREUR EXTRACTION'
On Error Resume Next
GoTo NouvelleExtractionATS

END SUB

La macro complete jointe

Merci par avance.

 

[pierrejean]

bonsoir

je suis tres loin de tout connaitre de la gestion des erreurs mais il me semble qu'un traitement d'erreur doit se terminer par

on error goto 0

 

[jfraynau]

Bonjour, et merci Pierre pour ta reponse.
Malheuresement cela n'a pas fonctionné 'On error goto 0'

Peut-être ai-je mal positionné le 'On error goto 0'


J'ai simplifié ma macro pour TEST.
Le Principe c'est de chercher a ouvrir une premiere fois un fichier qui n'existe pas. La macro va en gestion d'erreur et te dit que le fichier n'existe pas (Etiquette FichierATS elle te propose alors de boucler et d'ouvrir un autre fichier (Goto NouvelleExtractionATS) je reponds 'oui' ; boite de dialogue demandant le nom du nouveau fichier a ouvrir, je mets un nom de fichier qui n'existe pas, maintenant l'erreur n'est plus gerée et j'ai la boite de dialogue de debogage. Je n'arrive pas àcomprendre pourquoi il ne gere plus mes erreurs.

Detail de la macro a tester si vous voulez :

Sub TEST_GESTION_ERREUR()
Dim Fichier As String
Dim Msg, Style, Title, Response

ExtractionATS:
On Error GoTo FichierATS
Fichier = InputBox('Nom du Fichier ATS:', 'Extraction ATS', 'ats')

Workbooks.OpenText Filename:=Fichier
On Error GoTo AutreErreur

NouvelleExtractionATS:
Msg = 'Voulez vous formater un autre fichier ATS ?'
Style = vbYesNo + vbInformation + vbDefaultButton1
Title = 'EXTRACTION Suite...'

Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
GoTo ExtractionATS
End If

'==========GESTION DES ERREURS===========

NoProblemo:
MsgBox 'Extraction Terminée'
Exit Sub

FichierATS:
MsgBox 'Le Fichier est vide ou inexistant' & Chr(13) & 'Extraction Suivante...', vbCritical, 'ERREUR EXTRACTION'
On Error GoTo 0
GoTo NouvelleExtractionATS

AutreErreur:
MsgBox Err.Description
On Error GoTo 0
Exit Sub

End Sub

 

[Bernard_XLD]

Bonjour jfraynau, pierrejean

on n'utilise normalement pas de goto dans la gestion d'erreur, si tu veux faire ce type de traitement, utilise une variable que tu initialises avant ton resume next.
sans cela, pour tester si un fichier existe, pas besoin d'utiliser les erreurs, un simple
if dir(Fichier,vbnormal)='' then
suffit.
Comme tu fais actuellement, tes procédures deviennent des sous procédures de la gestion d'erreur, si tu as une deuxième erreur, plantage car la sous procédure rappelle la procédure appelante, c'est le serpent qui se mord la queue.

Cordialement, A+

sinon un exemple de ton code modifié

Sub TEST_GESTION_ERREUR()
Dim Fichier As String
Dim Msg, Style, Title, Response

'ExtractionATS:
On Error GoTo FichierATS
Do
Fichier = InputBox('Nom du Fichier ATS:', 'Extraction ATS', 'ats')
Workbooks.OpenText Filename:=Fichier
Loop Until Response = vbNo
On Error GoTo AutreErreur
'code à exécuter
On Error GoTo 0
NoProblemo:
MsgBox 'Extraction Terminée'
Exit Sub
FichierATS:
Msg = 'Le Fichier est vide ou inexistant' & Chr(10) & 'Voulez vous formater un autre fichier ATS ?'
Style = vbYesNo + vbInformation + vbDefaultButton1
Title = 'EXTRACTION Suite...'
Response = MsgBox(Msg, Style, Title)
Resume Next
Exit Sub
AutreErreur:
MsgBox Err.Description
End Sub

 

[jfraynau]

Cela fonctionne...
Merci pour votre aide.
Bonne Journée

 

[Hervé]

bonjour tout le monde

une autre approche sans utilisation de goto.

Sub Bouton2_QuandClic()
Dim Fichierexistant As Object
Dim sortie As Boolean

Set Fichierexistant = CreateObject('Scripting.FileSystemObject')

Do
sortie = True
Fichier = InputBox('Nom du Fichier ATS:', 'Extraction ATS', 'ats')
If Fichier = '' Then Exit Sub

If Not Fichierexistant.FileExists(Fichier) Then
        MsgBox 'Le Fichier est vide ou inexistant' & Chr(13) & 'Extraction Suivante...', vbCritical, 'ERREUR EXTRACTION'
        If MsgBox('Voulez vous formater un autre fichier ATS ?', vbYesNo + vbInformation + vbDefaultButton1, 'EXTRACTION Suite...') = vbYes Then
                sortie = False
        End If
End If
Loop Until sortie
                       

End Sub

salut