déplacement fichiers

Le
STEPH B
Bonjour

sous un répertoire nommé s:scanner
j'ai des fichiers par exemple 8000.pdf mais les noms peuvent varier mais
quoi qu'il arrive les noms de fichiers sont nommés de la sorte 4chiffres.pdf

ensuite j'ai un répertoire nommé s: sui comporte des répertoires nommés par
exemple s:8000 arfwdfqsfqsdfqsertfgdgdfgdfg

je voudrais qu'il me mettre le 8000.pdf sous le répertoire s:8000
arfwdfqsfqsdfqsertfgdgdfgdfg et ce pour tous les fichiers pdf qui ont comme
nom 4 chiffres.pdf

ex 8000.pdf sous s:8000 arfwdfqsfqsdfqsertfgdgdfgdfg
8201.pdf sous s:8201 sqdmljzaeoip

merci d avance.
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Charabeuh
Le #22348371
Bonjour,
Un début de piste:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Sub Test()

Dim MonRepPDF, MonFichierPDF
Dim MonDossierCible, MonSousDossier
Dim MonDicoPDF, MonDicoSousDossier
Dim IndexPDF, IndexDossier, I

'Le dossier des PDF
MonRepPDF = "S:Scanner"
'Le dossier cible
MonDossierCible = "S:SUI"

'Construction de la collection des PDF
Set MonDicoPDF = CreateObject("Scripting.Dictionary")
MonFichierPDF = Dir(MonRepPDF & "*.pdf")
Do While MonFichierPDF <> ""
IndexPDF = Left(MonFichierPDF, 4)
If IndexPDF >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoPDF.exists(IndexPDF) Then
MonDicoPDF.Add IndexPDF, MonFichierPDF
End If
End If
MonFichierPDF = Dir
Loop

'Construction de la collection des sous-dossiers cible
Set MonDicoSousDossier = CreateObject("Scripting.Dictionary")
MonSousDossier = Dir(MonDossierCible, vbDirectory)
Do While MonSousDossier <> ""
If MonSousDossier IndexDossier = Left(MonSousDossier, 4)
If IndexDossier >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoSousDossier.exists(IndexDossier) Then
MonDicoSousDossier.Add IndexDossier, MonSousDossier
End If
End If
End If
MonSousDossier = Dir
Loop

'Copie et suppression
Dim ClefPDF, Fsource, Fcible
ClefPDF = MonDicoPDF.keys
For I = 0 To MonDicoPDF.Count - 1
If MonDicoSousDossier.exists(ClefPDF(I)) Then
Fsource = MonRepPDF & MonDicoPDF.Item(ClefPDF(I))
Fcible = MonDossierCible & _
MonDicoSousDossier.Item(ClefPDF(I)) & _
"" & MonDicoPDF.Item(ClefPDF(I))
FileCopy Fsource, Fcible
Kill Fsource
End If
Next I

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

"STEPH B" discussion : 4c3abeff$0$2963$
Bonjour

sous un répertoire nommé s:scanner
j'ai des fichiers par exemple 8000.pdf mais les noms peuvent varier mais
quoi qu'il arrive les noms de fichiers sont nommés de la sorte
4chiffres.pdf

ensuite j'ai un répertoire nommé s: sui comporte des répertoires nommés
par exemple s:8000 arfwdfqsfqsdfqsertfgdgdfgdfg

je voudrais qu'il me mettre le 8000.pdf sous le répertoire s:8000
arfwdfqsfqsdfqsertfgdgdfgdfg et ce pour tous les fichiers pdf qui ont
comme nom 4 chiffres.pdf...

ex 8000.pdf sous s:8000 arfwdfqsfqsdfqsertfgdgdfgdfg
8201.pdf sous s:8201 sqdmljzaeoip

merci d avance.


STEPH B
Le #22351831
merci pour ce début de piste, mais ca fait rien


"Charabeuh" i1eoqr$9t8$
Bonjour,
Un début de piste:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Sub Test()

Dim MonRepPDF, MonFichierPDF
Dim MonDossierCible, MonSousDossier
Dim MonDicoPDF, MonDicoSousDossier
Dim IndexPDF, IndexDossier, I

'Le dossier des PDF
MonRepPDF = "S:Scanner"
'Le dossier cible
MonDossierCible = "S:SUI"

'Construction de la collection des PDF
Set MonDicoPDF = CreateObject("Scripting.Dictionary")
MonFichierPDF = Dir(MonRepPDF & "*.pdf")
Do While MonFichierPDF <> ""
IndexPDF = Left(MonFichierPDF, 4)
If IndexPDF >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoPDF.exists(IndexPDF) Then
MonDicoPDF.Add IndexPDF, MonFichierPDF
End If
End If
MonFichierPDF = Dir
Loop

'Construction de la collection des sous-dossiers cible
Set MonDicoSousDossier = CreateObject("Scripting.Dictionary")
MonSousDossier = Dir(MonDossierCible, vbDirectory)
Do While MonSousDossier <> ""
If MonSousDossier IndexDossier = Left(MonSousDossier, 4)
If IndexDossier >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoSousDossier.exists(IndexDossier) Then
MonDicoSousDossier.Add IndexDossier, MonSousDossier
End If
End If
End If
MonSousDossier = Dir
Loop

'Copie et suppression
Dim ClefPDF, Fsource, Fcible
ClefPDF = MonDicoPDF.keys
For I = 0 To MonDicoPDF.Count - 1
If MonDicoSousDossier.exists(ClefPDF(I)) Then
Fsource = MonRepPDF & MonDicoPDF.Item(ClefPDF(I))
Fcible = MonDossierCible & _
MonDicoSousDossier.Item(ClefPDF(I)) & _
"" & MonDicoPDF.Item(ClefPDF(I))
FileCopy Fsource, Fcible
Kill Fsource
End If
Next I

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

"STEPH B" discussion : 4c3abeff$0$2963$
Bonjour

sous un répertoire nommé s:scanner
j'ai des fichiers par exemple 8000.pdf mais les noms peuvent varier mais
quoi qu'il arrive les noms de fichiers sont nommés de la sorte
4chiffres.pdf

ensuite j'ai un répertoire nommé s: sui comporte des répertoires nommés
par exemple s:8000 arfwdfqsfqsdfqsertfgdgdfgdfg

je voudrais qu'il me mettre le 8000.pdf sous le répertoire s:8000
arfwdfqsfqsdfqsertfgdgdfgdfg et ce pour tous les fichiers pdf qui ont
comme nom 4 chiffres.pdf...

ex 8000.pdf sous s:8000 arfwdfqsfqsdfqsertfgdgdfgdfg
8201.pdf sous s:8201 sqdmljzaeoip

merci d avance.


Charabeuh
Le #22352101
Avez-vous saisi les noms des bons dossiers ?

'Le dossier des PDF
MonRepPDF = "S:Scanner"
'Le dossier cible qui contient les sous-répertoire
'de type 8000 arfwdfqsfqsdfqsertfgdgdfgdfg
MonDossierCible = "S:SUI"

"STEPH B" discussion : 4c3c4978$0$27589$
merci pour ce début de piste, mais ca fait rien


"Charabeuh" i1eoqr$9t8$
Bonjour,
Un début de piste:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Sub Test()

Dim MonRepPDF, MonFichierPDF
Dim MonDossierCible, MonSousDossier
Dim MonDicoPDF, MonDicoSousDossier
Dim IndexPDF, IndexDossier, I

'Le dossier des PDF
MonRepPDF = "S:Scanner"
'Le dossier cible
MonDossierCible = "S:SUI"

'Construction de la collection des PDF
Set MonDicoPDF = CreateObject("Scripting.Dictionary")
MonFichierPDF = Dir(MonRepPDF & "*.pdf")
Do While MonFichierPDF <> ""
IndexPDF = Left(MonFichierPDF, 4)
If IndexPDF >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoPDF.exists(IndexPDF) Then
MonDicoPDF.Add IndexPDF, MonFichierPDF
End If
End If
MonFichierPDF = Dir
Loop

'Construction de la collection des sous-dossiers cible
Set MonDicoSousDossier = CreateObject("Scripting.Dictionary")
MonSousDossier = Dir(MonDossierCible, vbDirectory)
Do While MonSousDossier <> ""
If MonSousDossier IndexDossier = Left(MonSousDossier, 4)
If IndexDossier >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoSousDossier.exists(IndexDossier) Then
MonDicoSousDossier.Add IndexDossier, MonSousDossier
End If
End If
End If
MonSousDossier = Dir
Loop

'Copie et suppression
Dim ClefPDF, Fsource, Fcible
ClefPDF = MonDicoPDF.keys
For I = 0 To MonDicoPDF.Count - 1
If MonDicoSousDossier.exists(ClefPDF(I)) Then
Fsource = MonRepPDF & MonDicoPDF.Item(ClefPDF(I))
Fcible = MonDossierCible & _
MonDicoSousDossier.Item(ClefPDF(I)) & _
"" & MonDicoPDF.Item(ClefPDF(I))
FileCopy Fsource, Fcible
Kill Fsource
End If
Next I

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Charabeuh
Le #22352091
A priori j'ai interprété dans votre message initial "s: sui..." comme le
nom d'un répertoire alors qu'il fallait lire "s: qui..."
il faut alors remplacer dans le code:

'Le dossier des PDF
MonRepPDF = "S:Scanner"
'Le dossier cible
MonDossierCible = "S:SUI"

par:

'Le dossier des PDF
MonRepPDF = "S:Scanner"
'Le dossier cible
MonDossierCible = "S:"




"STEPH B" discussion : 4c3c4978$0$27589$
merci pour ce début de piste, mais ca fait rien


"Charabeuh" i1eoqr$9t8$
Bonjour,
Un début de piste:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private Sub Test()

Dim MonRepPDF, MonFichierPDF
Dim MonDossierCible, MonSousDossier
Dim MonDicoPDF, MonDicoSousDossier
Dim IndexPDF, IndexDossier, I

'Le dossier des PDF
MonRepPDF = "S:Scanner"
'Le dossier cible
MonDossierCible = "S:SUI"

'Construction de la collection des PDF
Set MonDicoPDF = CreateObject("Scripting.Dictionary")
MonFichierPDF = Dir(MonRepPDF & "*.pdf")
Do While MonFichierPDF <> ""
IndexPDF = Left(MonFichierPDF, 4)
If IndexPDF >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoPDF.exists(IndexPDF) Then
MonDicoPDF.Add IndexPDF, MonFichierPDF
End If
End If
MonFichierPDF = Dir
Loop

'Construction de la collection des sous-dossiers cible
Set MonDicoSousDossier = CreateObject("Scripting.Dictionary")
MonSousDossier = Dir(MonDossierCible, vbDirectory)
Do While MonSousDossier <> ""
If MonSousDossier IndexDossier = Left(MonSousDossier, 4)
If IndexDossier >= 1000 And IndexPDF <= 9999 Then
If Not MonDicoSousDossier.exists(IndexDossier) Then
MonDicoSousDossier.Add IndexDossier, MonSousDossier
End If
End If
End If
MonSousDossier = Dir
Loop

'Copie et suppression
Dim ClefPDF, Fsource, Fcible
ClefPDF = MonDicoPDF.keys
For I = 0 To MonDicoPDF.Count - 1
If MonDicoSousDossier.exists(ClefPDF(I)) Then
Fsource = MonRepPDF & MonDicoPDF.Item(ClefPDF(I))
Fcible = MonDossierCible & _
MonDicoSousDossier.Item(ClefPDF(I)) & _
"" & MonDicoPDF.Item(ClefPDF(I))
FileCopy Fsource, Fcible
Kill Fsource
End If
Next I

End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Publicité
Poster une réponse
Anonyme