Renommer, copier dans un dossier puis supprimer plusieurs fichiers

Bonjour

Dans un classeur "NOMCLASSEUR", j'ai fait dans la feuille 2 "FEUILLEA" une requête automatisée (extraction et traitement du dossier A "DOSSIERA" pour récupérer dans un tableau les informations suivantes :

Ligne d'en tête (ligne 5) :

oldname

extension

Date created

Folder Path

newname

Soit :

  • A6:Axxxx = l'ancien nom du fichier sans extension
  • B6:Bxxxx = l'extension
  • D6:Cxxxx = folder path
  • E6:Exxxx = le nouveau nom du fichier sans extension

(xxxx variable correspondant au numéro de la dernière ligne)

Je souhaiterais faire une VBA qui réalise les actions suivantes :

  1. Si l'un des fichier est ouvert alors ne rien faire et afficher un message A "MESSAGEA" demandant de fermer les fichiers et de recommencer la procédure. (sans que rien ne soit effectué)
  2. Si pas de fichier ouvert :
    1. Renommer le nom de mes fichiers du dossier A récupérer dans le tableau ci-dessus (oldnam) par le nom newnam (précision, il peut y avoir des fichiers dans le dossier A qui n'ont pas été récupéré par ma requête)
    2. Copier ou déplacer ces fichiers du dossier A avec ce nouveau nom newnam dans un dossier B "DOSSIERB" (mais pas ceux qui n'ont pas été récupérer par ma requête tableau)
      1. si copie : effacer les anciens fichiers copiés du dossier A, mais pas ceux non concernés
    3. Afficher un message pour me dire que tous les fichiers ont été renommé/déplacer

J'ai par curiosité demandé à ChatGPT pour voir s'il était capable de me faire une VBA, mais elle ne fonctionne pas vraiment. La voici pour info :

Sub RenameAndMoveFiles()

Dim path As String
Dim newPath As String
Dim oldName As String
Dim newName As String
Dim extension As String
Dim rowCount As Integer

' Spécifier le chemin du dossier de destination.
newPath = "C:\Users\gmartin\OneDrive - cpage\Guillaume_one\interne\FRAIS-REMBOURSSEMENT\1. A ENVOYER\dossierstest2\"

' Obtenir le nombre de lignes remplies dans la feuille NOM©FICHIER.
rowCount = Worksheets("NOM©FICHIER").UsedRange.Rows.Count

' Boucler sur toutes les lignes remplies dans le tableau.
For i = 6 To rowCount

' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
oldName = Worksheets("NOM©FICHIER").Cells(i, 1).Value
extension = Worksheets("NOM©FICHIER").Cells(i, 2).Value
path = Worksheets("NOM©FICHIER").Cells(i, 4).Value
newName = Worksheets("NOM©FICHIER").Cells(i, 5).Value

' Exclure les fichiers ouverts.
If Not IsFileOpen(path & oldName) Then

' Renommer et copier le fichier.
Name path & oldName As newPath & newName & extension

Kill path & oldName & extension

End If
Next i
End Sub

Function IsFileOpen(filename As String) As Boolean

Dim filenum As Integer
Dim errnum As Integer

On Error Resume Next

' Essayer d'ouvrir le fichier en mode d'écriture pour vérifier s'il est ouvert.
filenum = FreeFile()
Open filename For Output Lock Read Write As #filenum
Close filenum
errnum = Err

' Réinitialiser les erreurs.
Err.Clear

' Si l'erreur est "Permission refusée", le fichier est déjà ouvert.
If errnum = 70 Then
IsFileOpen = True
End If

End Function

Edit modo : merci de mettre le code entre balises SVP avec le bouton </>

Merci beaucoup pour votre aide et explications (je suis un novice dans ce domaine )

bonjour,

mais elle ne fonctionne pas vraiment. La voici pour info :

mais encore ... reçois-tu un message d'erreur ? Qu'est-ce qui ne se passe pas comme tu l'attends ?

l'instruction name permet de renommer un fichier et de le changer de répertoire pour autant qu'il se trouve sur le même média (même disque, même clé usb, ...). Sinon il faut copier le fichier d'un média à l'autre en le renommant puis supprimer le fichier initial.

donc

si sur le même média le kill donnera une erreur. (ne trouvera plus le fichier car il été renommé)

si sur des médias différents le name ne fonctionnera normalement pas.

bonjour h2so4,

Oui les dossiers (A et B) sont sur le même disque et dans un même dossier de mon ordinateur.

Ce qui ne fonctionne pas :

- ça me renomme les fichiers mais sans les extensions et ça enlève l'extension des fichiers old.

- si un fichier est ouvert ça fait quand même l'action sur les autres fichiers

Voici un autre bout de code qui fonctionne bien pour renommer un fichier dans un même dossier. il me manque encore le mettre dans un autre dossier et surtout la notion de fichier ouvert.

Sub VBARENOMMERFICHIERAA()
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim chemin As String 'déclare la variable chemin
Dim Fichier As String 'déclare la variable Fichier
Dim NNom As String 'déclare la variable NNom (Nouveau Nom)
Dim FS, F 'déclare les variable FS et F

DL = Worksheets("Feuil2").Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée de la colonne A de l'onglet "Feuil1"
For I = 9 To DL 'boucle des lignes 9 à DL
    chemin = Cells(I, "B").Value 'définit le chemin de la cellule de la boucle en colonne B
    Fichier = Cells(I, "C").Value 'définit le Fichier de la cellule de la boucle en colonne B
    NNom = Cells(I, "G").Value 'définit le nouveau nom NNom de la cellule de la boucle en colonne C
    Set FS = CreateObject("Scripting.FileSystemObject") 'obligatoire si on veut travailler sur les fichiers c'est le Système des fichiers du PC
    Set F = FS.GEtFile(chemin & "\" & Fichier)  'définit le fichier F
    F.Name = NNom 'change le nom du fichier
Next I 'prochaine ligne de la boucle
End Sub

bonjour,

pour lancer l'action si aucun fichier n'est ouvert, il faut d'abord avoir vérifié qu'il n'y a aucun fichier ouvert en parcourant leur liste, ceci peut prendre du temps et comme ça peut prendre du temps, il y a une possibilité que quelqu'un ouvre le fichier après qu'on a testé si le fichier était ouvert ou non.

Je ne vois pas comment contourner ce problème potentiel autrement qu'en manipulant les droits d'accès.

Si tu estimes que la probabilité d'un tel cas est nulle, faire précéder la phase renommer/copier par un test de fichiers ouverts ne nécessite qu'une légère adaptation des codes que tu as trouvés.

voici ton code initial adapté en ce sens (non testé !!!!), donc soit sûr d'avoir un bon backup.

pour que cela fonctionne

path et new path doivent contenir le chemin du répertoire y compris tous les "\" et se terminer par un "\"

extension doit contenir l'extension précédée d'un "."

Sub RenameAndMoveFiles()

    Dim path As String
    Dim newPath As String
    Dim oldName As String
    Dim newName As String
    Dim extension As String
    Dim rowCount As Integer

    ' Spécifier le chemin du dossier de destination.
    newPath = "C:\Users\gmartin\OneDrive - cpage\Guillaume_one\interne\FRAIS-REMBOURSSEMENT\1. A ENVOYER\dossierstest2\"

    ' Obtenir le nombre de lignes remplies dans la feuille NOM©FICHIER.
    rowCount = Worksheets("NOM©FICHIER").UsedRange.Rows.Count

    ' Boucler sur toutes les lignes remplies dans le tableau, pour vérifier si aucun fichier n'est ouvert
    For i = 6 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("NOM©FICHIER").Cells(i, 1).Value
        extension = Worksheets("NOM©FICHIER").Cells(i, 2).Value
        path = Worksheets("NOM©FICHIER").Cells(i, 4).Value

        ' tester si  fichiers ouverts.
        If IsFileOpen(path & oldName & extension) Then
            MsgBox " fichier " & path & oldName & extension & " est ouvert, veuillez le fermer et recommencer"
            Exit Sub

        End If
    Next i

    For i = 6 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("NOM©FICHIER").Cells(i, 1).Value
        extension = Worksheets("NOM©FICHIER").Cells(i, 2).Value
        path = Worksheets("NOM©FICHIER").Cells(i, 4).Value
        newName = Worksheets("NOM©FICHIER").Cells(i, 5).Value

        ' Renommer et copier le fichier.
        Name path & oldName & extension As newPath & newName & extension

    Next i
End Sub

Function IsFileOpen(filename As String) As Boolean

    Dim filenum As Integer
    Dim errnum As Integer

    On Error Resume Next

    ' Essayer d'ouvrir le fichier en mode d'écriture pour vérifier s'il est ouvert.
    filenum = FreeFile()
    Open filename For Output Lock Read Write As #filenum
    Close filenum
    errnum = Err

    ' Réinitialiser les erreurs.
    Err.Clear

    ' Si l'erreur est "Permission refusée", le fichier est déjà ouvert.
    If errnum = 70 Then
        IsFileOpen = True
    End If

End Function

je suis absent pour le weekend de Pâques mais je vais essayer ta solution et je te dis ça rapidement . Merci pour ton temps et bon weekend

Je viens de faire le test :

si un fichier est ouvert (pdf ou word) : il ne m'affiche pas de message spécifique.
Si j'ai un document word par exemple (.doc) dans la liste des documents, il ne le renomme pas et il ne le copie pas

bonjour,

je viens de faire le test (en respectant les contraintes que j'ai mentionnées plus haut).

avec document .docx et .pdf ouverts, je reçois bien un message

si aucun document n'est ouvert, le changement de répertoire et le changement de nom se passent bien.

Vérifie bien si les données dans tes colonnes A,B,D,E respectent bien les contraintes et que la première ligne contenant des données est la 6ème.

hello h2so4,

Après vérification minutieuse des paramètres et de la macro, je viens de refaire plusieurs tests et ça ne fonctionne pas.

Si un fichier PDF est ouvert, il fait quand même le changement de nom et copie des fichiers (pdf) dans le dossier2.
Les fichier word (Doc) ne sont pas renommé et pas mis dans le dossier2 .

Il y a surement quelque chose qui ne fonctionne pas mais je ne comprends pas quoi.

Est-ce la macro qui n'est pas bonne ?

Bonjour,

Est-ce la macro qui n'est pas bonne ?

Comme cela fonctionne chez moi, je suppose que c'est la raison ...

Remplace le code de la fonction IsFileOpen par le code ci-dessous. Je n'avais pas vérifié cette partie du code et j'espère que tu ne l'as pas utilisée sur des fichiers importants pour toi. Le code (de chatgpt si j'ai bien compris) efface purement et simplement le contenu des fichiers testés.

Function IsFileOpen(filename As String) As Boolean

    Dim filenum As Integer
    Dim errnum As Integer

    On Error Resume Next
    IsFileOpen = False
    ' Essayer d'ouvrir le fichier en mode lecture pour vérifier s'il est ouvert.
    filenum = FreeFile()
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err

    ' Réinitialiser les erreurs.
    Err.Clear

    ' Si l'erreur est "Permission refusée", le fichier est déjà ouvert.
    If errnum = 70 Then
        IsFileOpen = True
    ElseIf errnum <> 0 Then 'autre erreur
       MsgBox "erreur " & errnum & " : " & Error(errnum) & " à l'ouverture du fichier " & filename
       IsFileOpen = True
    End If

End Function

Réessaie et dis-moi si tu reçois un message d'erreur.

edit : remarque concernant le code proposé par chat GPT.

Hello,

  • si le Word est ouvert alors j'ai bien le message avec le nom du fichier et rien ne se passe.
  • Si PDF ouvert j'ai le message suivant : "fichier est ouvert, veuillez le fermer et recommencer"

De plus la vba me fait un changement et un couper coller dans le dossier2 que sur les fichiers pdf. Les word restent dans le dossier1 et sans modification de nom.

Je n'arrive pas à comprendre ce qui cloche. Je te remets la vba que j'utilise peut etre cela vient de la macro directement ?

Sub RenameAndMoveFiles()

    Dim path As String
    Dim newPath As String
    Dim oldName As String
    Dim newName As String
    Dim extension As String
    Dim rowCount As Integer

    ' Spécifier le chemin du dossier de destination.
    newPath = "....\Desktop\TESTEXCEL\dossierstest2\"

    ' Obtenir le nombre de lignes remplies dans la feuille NOM©FICHIER.
    rowCount = Worksheets("Feuil2").UsedRange.Rows.Count

    ' Boucler sur toutes les lignes remplies dans le tableau avec pour première ligne 9, pour vérifier si aucun fichier n'est ouvert
    For i = 9 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("Feuil2").Cells(i, 4).Value
        extension = Worksheets("Feuil2").Cells(i, 5).Value
        path = Worksheets("Feuil2").Cells(i, 2).Value

        ' tester si  fichiers ouverts.
        If IsFileOpen(path & oldName & extension) Then
            MsgBox " fichier " & path & oldName & extension & " est ouvert, veuillez le fermer et recommencer"
            Exit Sub

        End If
    Next i

    For i = 9 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("Feuil2").Cells(i, 4).Value
        extension = Worksheets("Feuil2").Cells(i, 5).Value
        path = Worksheets("Feuil2").Cells(i, 2).Value
        newName = Worksheets("Feuil2").Cells(i, 6).Value

        ' Renommer et copier le fichier.
        Name path & oldName & extension As newPath & newName & extension

    Next i
End Sub

Function IsFileOpen(filename As String) As Boolean

    Dim filenum As Integer
    Dim errnum As Integer

    On Error Resume Next
    IsFileOpen = False
    ' Essayer d'ouvrir le fichier en mode lecture pour vérifier s'il est ouvert.
    filenum = FreeFile()
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err

    ' Réinitialiser les erreurs.
    Err.Clear

    ' Si l'erreur est "Permission refusée", le fichier est déjà ouvert.
    If errnum = 70 Then
        IsFileOpen = True
    ElseIf errnum <> 0 Then 'autre erreur
       MsgBox "erreur " & errnum & " : " & Error(errnum) & " à l'ouverture du fichier " & filename
       IsFileOpen = True
    End If

End Function

bonjour,

si le Word est ouvert alors j'ai bien le message avec le nom du fichier et rien ne se passe.

Si PDF ouvert j'ai le message suivant : "fichier est ouvert, veuillez le fermer et recommencer"

si le fichier word est ouvert, quel message reçois-tu et en quoi est-il différent de celui que tu reçois pour les fichiers pdf ?

Bonjour h2so4,

J'ai bien ces messages quand un Word est ouvert ou quand un PDF est ouvert.

si le Word est ouvert alors j'ai bien le message avec le nom du fichier et rien ne se passe : "....\Desktop\TESTEXCEL\dossierstest21\testword.doc est ouvert, veuillez le fermer et recommencer"

Si PDF ouvert, j'ai le message suivant : "fichier est ouvert, veuillez le fermer et recommencer."

J'ai par contre deux soucis :

  1. Quand un fichier PDF était ouvert, que le message "fichier est ouvert, veuillez le fermer et recommencer" est apparu et que j'ai fermé le fichier, je ne peux plus lancer la macro, car le message "fichier est ouvert, veuillez le fermer et recommencer" apparaît à chaque fois alors que tout est fermé à part mon fichier Excel comprenant la macro.
  2. Quand je lance la macro seulement les fichiers PDF sont renommés et mis dans le dossier2. Les WORD, eux, restent dans le dossier1 avec leurs anciens noms.

Bonjour,

cette macro fonctionnant sans problème chez moi, le problème que tu rencontres doit être lié aux données du classeur et/ou à ton environnement que je ne connais pas.

J'ai modifié le code pour y inclure un logging des actions faites par le programme. Modifie éventuellement son chemin, lance la macro et tiens-moi au courant.

Sub RenameAndMoveFiles()

    Dim path As String
    Dim newPath As String
    Dim oldName As String
    Dim newName As String
    Dim extension As String
    Dim rowCount As Integer

    ' Spécifier le chemin du dossier de destination.
    newPath = "\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossierstest2\"
    Open "c:\temp\testexellog.txt" For Output As 1 'fichier log
    ' Obtenir le nombre de lignes remplies dans la feuille NOM©FICHIER.
    rowCount = Worksheets("Feuil2").UsedRange.Rows.Count

    ' Boucler sur toutes les lignes remplies dans le tableau, pour vérifier si aucun fichier n'est ouvert
    For i = 9 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("Feuil2").Cells(i, 4).Value
        extension = Worksheets("Feuil2").Cells(i, 5).Value
        path = Worksheets("Feuil2").Cells(i, 2).Value
        Print #1, "test si fichier " & path & oldName & extension & " est ouvert : ";
        ' tester si  fichiers ouverts.
        If IsFileOpen(path & oldName & extension) Then
            MsgBox " fichier " & path & oldName & extension & " est ouvert, veuillez le fermer et recommencer"
            Print #1, "fichier ouvert"
            Exit Sub
        End If
        Print #1, " fichier fermé"
    Next i

    For i = 9 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("Feuil2").Cells(i, 4).Value
        extension = Worksheets("Feuil2").Cells(i, 5).Value
        path = Worksheets("Feuil2").Cells(i, 2).Value
        newName = Worksheets("Feuil2").Cells(i, 6).Value
        Print #1, "renomme et copie le fichier " & path & oldName & extension & " en " & newPath & newName & extension
        ' Renommer et copier le fichier.
        Name path & oldName & extension As newPath & newName & extension

    Next i
    Close 1
End Sub

Function IsFileOpen(filename As String) As Boolean

    Dim filenum As Integer
    Dim errnum As Integer

    On Error Resume Next
    IsFileOpen = False
    ' Essayer d'ouvrir le fichier en mode lecture pour vérifier s'il est ouvert.
    filenum = FreeFile()
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err

    ' Réinitialiser les erreurs.
    Err.Clear

    ' Si l'erreur est "Permission refusée", le fichier est déjà ouvert.
    If errnum = 70 Then
        IsFileOpen = True
    ElseIf errnum <> 0 Then 'autre erreur
       MsgBox "erreur " & errnum & " : " & Error(errnum) & " à l'ouverture du fichier " & filename
       IsFileOpen = True
    End If

End Function

Le problème est toujours le même.

Penses-tu que je devrais mettre mon Excel dans un autre dossier que celui parent du dossier1 et dossier2 ?

de ton côté ça fonctionne correctement pourtant ? J'ai même essayé de refaire un excel propre en me disant que ça venait de là. J'ai une requête power query avant ça pourrait être source de conflit ?

bonjour,

peux-tu mettre le fichier logging créé ?

le fichier logging ? (tu veux dire le fichier Excel ? )

Bonjour,

je crains de ne pas avoir été assez précis.

J'ai modifié le code pour y inclure un logging des actions faites par le programme. Modifie éventuellement son chemin, lance la macro et tiens-moi au courant.

Pour essayer de comprendre un peu mieux ce qui se passe, tu verras dans le dernier code que j'ai fourni qu'il y a un fichier de logging (trace de toutes les actions faites par le programme), que j'ai nommé ainsi. "c:\temp\testexellog.txt"

Peux-tu relancer cette macro adaptée (change éventuellement son nom s'il ne te convient pas) dans ton environnement et mettre ce fichier ici ?

Bonjour,

J'ai refait le teste en lançant la macro mais en ayant ouvert un PDF et la j'obtiens le message me demandant de fermer celui-ci. Je le ferme et relance la macro et la un autre message arrive : photo jointe
Je ne peux plus relancer la macro sauf en fermant l'Excel et tout les fichiers et dossiers ouvert et en les rouvrant.

image

et le temps me montre cela :

test si fichier \\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T2.pdf est ouvert : fichier fermé

test si fichier \\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T3.pdf est ouvert : fichier fermé

test si fichier \\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T4.pdf est ouvert : fichier fermé

test si fichier \\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T8.pdf est ouvert : fichier fermé

test si fichier \\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest

or je n'ai pas de dossier se nommant "dossiertest" (dernière ligne)

enfin j'ai refait le teste avec les documents suivants (colone 2) dans le dossiertest1 (colone 1) :

\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\ER.xlsxSER
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T1.pdfS1
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T2.pdfS2
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T3.pdfS3
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T4.pdfS4
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\T8.pdfS8
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\TR.pdfSR
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\TWAC.docSWAC
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\TWAC2.docSWAC2
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\TWAC3.docSWAC3
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\utre.docSA
\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossiertest1\WR.docxSWR

tout c'est bien passé sauf pour WR.docx qui est resté dans le dossiertest1.

le temp en pj

8testexellog.txt (2.96 Ko)

Je viens de faire un dernier test et il me semble avoir trouvé le problème du fichier qui n'est pas renommé et mis dans le dossier.

C'est le dernier fichier du tableau. Si je rajoute une ligne au tableau alors la macro renomme bien tous les fichiers et les place dans le dossiers2

Je me demande comment réussir à inscrire ça dans la macro.

Si on y arrive, il restera tjrs le problème du PDF ouvert ...

bonjour,

une nouvelle version

correction du calcul de la dernière ligne et correction du nom partiel dans le logging. (si cela fonctionne correctement, tu pourras, si tu le souhaites, supprimer toutes les lignes se terminant par 'fichier log)

Sub RenameAndMoveFiles()

    Dim path As String
    Dim newPath As String
    Dim oldName As String
    Dim newName As String
    Dim extension As String
    Dim rowCount As Integer

    ' Spécifier le chemin du dossier de destination.
    newPath = "\\stbris\redirect$\gmartin\Desktop\TESTEXCEL\dossierstest2\"
    Open "c:\temp\testexellog.txt" For Output As 1 'fichier log
    ' Obtenir le nombre de lignes remplies dans la feuille NOM©FICHIER.
    rowCount = Worksheets("Feuil2").Cells(Rows.Count, 2).End(xlUp).Row

    ' Boucler sur toutes les lignes remplies dans le tableau, pour vérifier si aucun fichier n'est ouvert
    For i = 9 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("Feuil2").Cells(i, 4).Value
        extension = Worksheets("Feuil2").Cells(i, 5).Value
        path = Worksheets("Feuil2").Cells(i, 2).Value
        Print #1, "test si fichier " & path & oldName & extension & " est ouvert : ";
        ' tester si  fichiers ouverts. 'fichier log
        If IsFileOpen(path & oldName & extension) Then
            MsgBox " fichier " & path & oldName & extension & " est ouvert, veuillez le fermer et recommencer"
            Print #1, "fichier ouvert" ''fichier log
            Close 1
            Exit Sub
        End If
        Print #1, " fichier fermé" 'fichier log
    Next i

    For i = 9 To rowCount

        ' Obtenir l'ancien nom, le chemin d'accès et le nouveau nom du fichier.
        oldName = Worksheets("Feuil2").Cells(i, 4).Value
        extension = Worksheets("Feuil2").Cells(i, 5).Value
        path = Worksheets("Feuil2").Cells(i, 2).Value
        newName = Worksheets("Feuil2").Cells(i, 6).Value
        Print #1, "renomme et copie le fichier " & path & oldName & extension & " en " & newPath & newName & extension
        ' Renommer et copier le fichier. 'fichier log
        Name path & oldName & extension As newPath & newName & extension

    Next i
    Close 1 'fichier log
End Sub

Function IsFileOpen(filename As String) As Boolean

    Dim filenum As Integer
    Dim errnum As Integer

    On Error Resume Next
    IsFileOpen = False
    ' Essayer d'ouvrir le fichier en mode lecture pour vérifier s'il est ouvert.
    filenum = FreeFile()
    Open filename For Input Lock Read As #filenum
    Close filenum
    errnum = Err

    ' Réinitialiser les erreurs.
    Err.Clear

    ' Si l'erreur est "Permission refusée", le fichier est déjà ouvert.
    If errnum = 70 Then
        IsFileOpen = True
    ElseIf errnum <> 0 Then 'autre erreur
       MsgBox "erreur " & errnum & " : " & Error(errnum) & " à l'ouverture du fichier " & filename
       IsFileOpen = True
    End If

End Function

Pour consulter/modifier le PDF quel programme utilises-tu ?

Rechercher des sujets similaires à "renommer copier dossier puis supprimer fichiers"