déplacement fichiers

4 réponses

STEPH B

12/07/2010 à 09:05

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.

4 réponses

Charabeuh

12/07/2010 à 11:55

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 <> "." And MonSousDossier <> ".." Then
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" a écrit dans le message de groupe de
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.

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 <> "." And MonSousDossier <> ".." Then
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" <stephol@prodiag.fr> a écrit dans le message de groupe de
discussion : 4c3abeff$0$2963$ba4acef3@reader.news.orange.fr...

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.

Vous avez filtré cet utilisateur ! Consultez son message

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

13/07/2010 à 13:03

merci pour ce début de piste, mais ca fait rien

"Charabeuh" a écrit dans le message de news:
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 <> "." And MonSousDossier <> ".." Then
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" a écrit dans le message de groupe de
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.

merci pour ce début de piste, mais ca fait rien

"Charabeuh" <Please@FeedBack.fr> a écrit dans le message de news:
i1eoqr$9t8$1@speranza.aioe.org...

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 <> "." And MonSousDossier <> ".." Then
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" <stephol@prodiag.fr> a écrit dans le message de groupe de
discussion : 4c3abeff$0$2963$ba4acef3@reader.news.orange.fr...

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.

Vous avez filtré cet utilisateur ! Consultez son message

merci pour ce début de piste, mais ca fait rien

"Charabeuh" a écrit dans le message de news:
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 <> "." And MonSousDossier <> ".." Then
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" a écrit dans le message de groupe de
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

13/07/2010 à 14:12

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" a écrit dans le message de groupe de
discussion : 4c3c4978$0$27589$

merci pour ce début de piste, mais ca fait rien

"Charabeuh" a écrit dans le message de news:
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 <> "." And MonSousDossier <> ".." Then
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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" <stephol@prodiag.fr> a écrit dans le message de groupe de
discussion : 4c3c4978$0$27589$ba4acef3@reader.news.orange.fr...

merci pour ce début de piste, mais ca fait rien

"Charabeuh" <Please@FeedBack.fr> a écrit dans le message de news:
i1eoqr$9t8$1@speranza.aioe.org...

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 <> "." And MonSousDossier <> ".." Then
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Vous avez filtré cet utilisateur ! Consultez son message

merci pour ce début de piste, mais ca fait rien

"Charabeuh" a écrit dans le message de news:
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 <> "." And MonSousDossier <> ".." Then
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

13/07/2010 à 14:19

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" a écrit dans le message de groupe de
discussion : 4c3c4978$0$27589$

merci pour ce début de piste, mais ca fait rien

"Charabeuh" a écrit dans le message de news:
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 <> "." And MonSousDossier <> ".." Then
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

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" <stephol@prodiag.fr> a écrit dans le message de groupe de
discussion : 4c3c4978$0$27589$ba4acef3@reader.news.orange.fr...

merci pour ce début de piste, mais ca fait rien

"Charabeuh" <Please@FeedBack.fr> a écrit dans le message de news:
i1eoqr$9t8$1@speranza.aioe.org...

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 <> "." And MonSousDossier <> ".." Then
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Vous avez filtré cet utilisateur ! Consultez son message

merci pour ce début de piste, mais ca fait rien

"Charabeuh" a écrit dans le message de news:
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 <> "." And MonSousDossier <> ".." Then
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
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

déplacement fichiers

4 réponses

Veuillez sélectionner un problème