XL 2016 Problème d'utilisation ON ERROR RESUME NEXT

[jipi06]

Bonjour à toutes et tous
J’espère que tout va bien pour vous.
J'utilise un code qui me permet de transférer des fichiers qui sont listés dans une colonne B vers une liste de dossiers qui sont listés dans une colonne A sur le format suivant

Dossier

Fichier

_AUTREG_2_2206_2020-4-4_18h41_SAS FS2L

AUTREG_2_2206_2020-4-4_18h41_ACO-SAS FS2L.PDF

Code Utilisé
Sub deb()
Dim Fso As New Scripting.FileSystemObject
Chemin = Workbooks(ActiveWorkbook.Name).Path & "\"
drlg = dernièrelg(Sheets("Transfert"), 2)
Set Fso = CreateObject("scripting.filesystemobject")
With Sheets("Transfert")

On Error Resume Next
For n = 2 To drlg
Set fich = Fso.GetFile(Chemin & "total\" & .Cells(n, 2))
fich.Move (Chemin & .Cells(n, 1) & "\") ' Quand le dossier n'existe pas dans le répertoire cible...il s'arrête
Next
End With
End Sub

Ce code fonctionne très bien, quand Tous les dossiers existent.
En revanche, quand il ne trouve pas de dossier et ben il fait ce qui est écris ...il abandonne...

Je voudrais juste qu'il ne prenne pas en compte l'erreur et qu'il passe à la ligne suivante...c'est peut être un mauvais placement de On Error Resume Next .

Merci de votre aide

Jipi06

 

[chris]

Bonjour

Ce n'est pas une bonne pratique

Il vaut mieux tester la présence du fichier avec Dir et orienter la suite avec if

 

[eriiic]

Bonjour,

plus précisément, tester la présence du répertoire avec Dir et le créer si besoin avant la copie du fichier.
eric

 

[jipi06]

OK
Je sais un peu lire du vba et l'interpréter mais pas forcément tout écrire. Pourriez vous me donner un exemple de test.

Par ailleurs si le fichier qui est dans un dossier existe déjà est ce que je peux rajouter dans cette procédure une commande de remplacement automatique du fichier existant.

Merci de votre patience eriiiic
!

 

[eriiic]

If Dir(chemin, vbDirectory) = "" Then MkDir chemin

dans la mesure ou 'total' existe déjà. Si ça peut être le cas, même punition pour lui auparavant.

Je ne pratique pas beaucoup fso et je n'ai pas l'impression qu'un paramètre puisse forcer l'écrasement.
Teste l'existence du fichier, renomme-le en .bak avec Rename, fait ta copie.
Si tout s'est bien passé tu effaces le .bak sinon tu le renommes tel qu'il l'était

Quand tu utilises On Error Resume Next, ne le faire que pour une instruction dont l'erreur est prévue , normale et sans incidence. Et uniquement si la prévenir prendrait une peu trop de lignes de code ou trop de ressources.
Remettre aussitôt après la gestion d'erreur avec On error goto 0.
eric

 

[jipi06]

Merci eriiiic
je mets tout ça en place.

Merci beaucoup

 

[TooFatBoy]

Bonjour,

Sub deb()
Dim Fso As New Scripting.FileSystemObject

    Chemin = Workbooks(ActiveWorkbook.Name).Path & "\"
    drlg = dernièrelg(Sheets("Transfert"), 2)
    Set Fso = CreateObject("scripting.filesystemobject")

    With Sheets("Transfert")    
        On Error Resume Next
        For n = 2 To drlg
            Set fich = Fso.GetFile(Chemin & "total\" & .Cells(n, 2))
            fich.Move (Chemin & .Cells(n, 1) & "\")    ' Quand le dossier n'existe pas dans le répertoire cible... il s'arrête
        Next
    End With
End Sub

Ce code fonctionne très bien, quand tous les dossiers existent.
En revanche, quand il ne trouve pas de dossier eh bien il fait ce qui est écrit... il abandonne...

Perso, je trouve bizarre que la procédure s'arrête, puisqu'il y a "On Error Resume Next".
Le déroulement du code devrait continuer à l'instruction suivant celle ayant posé problème, et donc passer au fichier suivant, me semble-t-il.

Mais il est comme dit plus haut, mieux vaut gérer la non existence (suivie d'une création) des dossiers, pour y déplacer les fichiers (s'ils existent... ).

 

[laurent950]

Bonjour

Sub deb()
Dim Fso As New Scripting.FileSystemObject
    Chemin = Workbooks(ActiveWorkbook.Name).Path & "\"
    drlg = dernièrelg(Sheets("Transfert"), 2)
    With Sheets("Transfert")
        For n = 2 To drlg
        ' Quand le dossier n'existe pas dans le répertoire cible... soit False aucune Procédure !
            if GestionFichier.FolderExists(Chemin & .Cells(n, 1) & "\") <> false then
                Fso.MoveFile Chemin & "total\" & .Cells(n, 2), Chemin & .Cells(n, 1) & "\"
            end if
        Next
    End With
Set Fso = Nothing
End Sub

 

[jipi06]

Merci je vais tester tout cela
A+