Discussion :

[bervellea1]

Bonjour a tous,

j'ai mon fichier excel, dans la feuille 'suivi' qui comprend tous les devis, je veux pouvoir déplacer les devis vers un autre dossier "04-clos" si le dossier d'origine n'est pas "04-clos". j'ai fait une macro pour un menu contextuelle de sorte a ce que si on choisi l'option déplacement il exécute la macro de déplacement. il se trouve que ma macro de déplacement ne fonctionne pas. merci de m'aider.

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
Sub Sub_Déplacement_Clos()
Set fs = CreateObject("Scripting.FileSystemObject")
Dim Sh_Suivi As Worksheet
Set Sh_Suivi = Sheets("Suivi")
l = 2
l_fin = 2
Compteur = 0
Do While Sh_Suivi.Cells(l, P_Suivi_CheminFichier).Value <> ""
    If Not (Sh_Suivi_PTV.Cells(l, P_Suivi_CheminFichier).Value Like "*04-Clos*") Then
        Set f = fs.GetFile(Sh_Suivi.Cells(l, P_Suivi_CheminFichier).Value)
            Fichier = f.Name
            fs.movefile f.Path, "C:\\04-Clos\\"
            Action = "Clos"
            Chemin = "C:\04-Clos\" & Fichier
            Compteur = Compteur + 1
            l_fin = l_fin - 1
            Do While Sh_Suivi.Cells(l_fin, P_Suivi_CheminFichier).Value <> ""
                l_fin = l_fin + 1
            Loop
            Sh_Suivi.Cells(l_fin, P_Suivi_CheminFichier).Value = Chemin
    End If
l = l + 1
Loop
MsgBox Compteur & " fichiers déplacés", vbInformation, "Déplacement statut"
End Sub

Après la ligne Set f = fs.GetFile(Sh_Suivi.Cells(l, P_Suivi_CheminFichier).Value)
il passe directement au End If

[EricDgn]

(1) Pourquoi ne pas utiliser l'instruction Name OldName as NewName
(2) avant de déplacer un fichier, il serait utile de vérifier que ce fichier existe bien à l'endroit indiqué, et si non: le signaler

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
Sub Sub_Déplacement_Clos()
    Dim Sh_Suivi As Worksheet
    Dim FromPath As String, ToNewPath As String, kL As Long
    Set Sh_Suivi = Sheets("Suivi")
    kL = 2
    FromPath = Sh_Suivi.Cells(kL, 2)
    Do While FromPath <> ""
        If Not (FromPath Like "*04-Clos*") Then
            ToNewPath = "C:\04-Clos" & Mid(FromPath, InStrRev(FromPath, "\"))
            Debug.Print ToNewPath
            If Dir(FromPath) = "" Then
                MsgBox "Le fichier " & FromPath & " est manquant !", , "Anomalie"
            Else
                Name FromPath As ToNewPath
                Cells(kL, 2) = ToNewPath
            End If
        End If
        kL = kL + 1
        FromPath = Sh_Suivi.Cells(kL, 2)
    Loop
End Sub

Bonne continuation.

[Invité]

Bonjour,
Regarde ce lien tu y trouera ce que tu veux et plus!

http://www.developpez.net/forums/d15...l/#post8149786

[bervellea1]

Bonjour,
j'aimerais dire merci à tous ceux qui se sont penchés sur mon problème.
Merci particulier à EricDgn, ta solution avec quelques modifications a montré son efficacité.
Merci.