Discussion :

[olive59]

Bonjour,

Je cherche sous excel VB, une fonction à mettre dans une macro pour identifier un type de fichier par ces premieres lettres, soit CT3__T1A-7
Je veux déplacer d'un dossier tous les fichiers commencant par CT3__T1A-7 et garder les autres qui sont de la forme CT3__T1A-4
Merci de vos réponses

Cordialement

Olivier

[jfontaine]

Bonjour,

Ci dessous un code qui boucle sur les fichiers d'un répertoire et déplace les fichiers après traitement.

Restera a faire une petite adaptation pour le choix de fichiers a copier

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
Dim Fso As Object
Dim FsoRepertoire As Object
Dim FsoFichier As Object
 
Dim strRepertoire As String
 
strRepertoire = ThisWorkbook.Path
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRepertoire = Fso.GetFolder(ThisWorkbook.Path & "\Fichiers")
 
'Boucle sur fichiers du repertoire
For Each FsoFichier In FsoRepertoire.Files
    FsoFichier.Copy strRepertoire & "\Fichiers\" & FsoFichier.Name, True
    FsoFichier.Move strRepertoire & "\Save\" &  FsoFichier.Name
Next

[kiki29]

Salut,qqch comme ceci en l'insérant dans le code de Jérôme

Code :

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

1
2
    sNom = FSO.GetFileName(FsoFichier)
    If Left$(sNom, 10) = "CT3__T1A-7" Then ...

[olive59]

Pouvez vous être plus precis dans les instructions car je débute.
Merci d'avance

Olivier

[jfontaine]

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
 
Sub Deplacer()
 
Dim Fso As Object
Dim FsoRepertoire As Object
Dim FsoFichier As Object
 
Dim strRepertoire As String
 
strRepertoire = ThisWorkbook.Path
 
Set Fso = CreateObject("Scripting.FileSystemObject")
Set FsoRepertoire = Fso.GetFolder(ThisWorkbook.Path & "\Fichiers")
 
'Boucle sur fichiers du repertoire
For Each FsoFichier In FsoRepertoire.Files
  If Left$(FsoFichier.Name, 10) = "CT3__T1A-7" Then
    FsoFichier.Copy strRepertoire & "\Fichiers\" & FsoFichier.Name, True
    FsoFichier.Move strRepertoire & "\Save\" &  FsoFichier.Name
  end if
Next
 
end sub

[olive59]

Bonjour

Merci à vous pour ce programme qui fonctionne parfaitement
Cordialement

Olivier