classement de fichier

Le
achille
Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
MichD
Le #23246311
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion : 4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!
achille
Le #23246401
merci
ca a l air de marcher sauf que par exemple il me trouve un fichier 9965.pdf
et mon repertoire "s:9965 rue de paris" existe deja je voudrais qu'il me
copie le pdf dessous justement.

merci d avance


"MichD" imvpl2$sms$
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!

MichD
Le #23246511
OK, seulement à modifier la procédure test comme ceci :

'----------------------------------------
Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory) & ""
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'----------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion : 4d936de4$0$32456$

merci
ca a l air de marcher sauf que par exemple il me trouve un fichier 9965.pdf
et mon repertoire "s:9965 rue de paris" existe deja je voudrais qu'il me
copie le pdf dessous justement.

merci d avance


"MichD" imvpl2$sms$
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!

isabelle
Le #23246501
bonjour achille,

Sub CopieFichier()
Dim objFSO As Object, Dossier As Object
Dim Files As Object, File As Object, i As Integer
Dim NomDossier As String, rep As String, Source As String, Destination
As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
NomDossier = "f:DOSSIER"
Set Dossier = objFSO.GetFolder(NomDossier)
Set Files = Dossier.Files

If Files.Count <> 0 Then
For Each File In Files
rep = Split(Split(File.Name, ".")(0), " ")(0)
Source = NomDossier & File.Name
Destination = "s:NOM D UN REPERTOIRE" & rep
objFSO.CopyFile Source, Destination, OverwriteExisting
Next
End If
End Sub


isabelle
------------------------------------------------------------------

Le 2011-03-30 11:31, achille a écrit :
Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!



achille
Le #23247661
merci michel
mais il devrait le couper coller et non pas copier coller car cela pose un
probleme il boucle toujours sur le meme fichiers.

merci d'avance.

"MichD" imvtof$869$
OK, seulement à modifier la procédure test comme ceci :

'----------------------------------------
Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory) & ""
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'----------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d936de4$0$32456$

merci
ca a l air de marcher sauf que par exemple il me trouve un fichier
9965.pdf
et mon repertoire "s:9965 rue de paris" existe deja je voudrais qu'il me
copie le pdf dessous justement.

merci d avance


"MichD" imvpl2$sms$
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!




achille
Le #23247761
et aussi

si il trouve un fichier mais que le repertoire n'existe pas ben il saute
cette procedure car actuellement il recommence la boucle

merci a vous


"achille" 4d9440d8$0$7690$
merci michel
mais il devrait le couper coller et non pas copier coller car cela pose un
probleme il boucle toujours sur le meme fichiers.

merci d'avance.

"MichD" imvtof$869$
OK, seulement à modifier la procédure test comme ceci :

'----------------------------------------
Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory) & ""
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'----------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d936de4$0$32456$

merci
ca a l air de marcher sauf que par exemple il me trouve un fichier
9965.pdf
et mon repertoire "s:9965 rue de paris" existe deja je voudrais qu'il me
copie le pdf dessous justement.

merci d avance


"MichD" imvpl2$sms$
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!








achille
Le #23247861
merci isabelle mais ta procedure n est pas excatement ce que je souhaite ,
ma procédure ne concerne que les fichiers pdf.



"isabelle" imvtvb$8q8$
bonjour achille,

Sub CopieFichier()
Dim objFSO As Object, Dossier As Object
Dim Files As Object, File As Object, i As Integer
Dim NomDossier As String, rep As String, Source As String, Destination As
String

Set objFSO = CreateObject("Scripting.FileSystemObject")
NomDossier = "f:DOSSIER"
Set Dossier = objFSO.GetFolder(NomDossier)
Set Files = Dossier.Files

If Files.Count <> 0 Then
For Each File In Files
rep = Split(Split(File.Name, ".")(0), " ")(0)
Source = NomDossier & File.Name
Destination = "s:NOM D UN REPERTOIRE" & rep
objFSO.CopyFile Source, Destination, OverwriteExisting
Next
End If
End Sub


isabelle
------------------------------------------------------------------

Le 2011-03-30 11:31, achille a écrit :
Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!



MichD
Le #23247941
Dans un module standard :

'déclaration API dans le haut du module standard :
'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant
Dim A As Integer, T(), Elt As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
ReDim Preserve T(A)
T(A) = Fichier
A = A + 1
Fichier = Dir()
Loop
For Each Elt In T
Racine = Left(Elt, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory)
CopieDossier Repertoire_A_Scanner & Elt, _
Repertoire_Destination & Racine & "" & Elt, _
xlCopy, True
End If
Next

End Sub
'----------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion : 4d9440d8$0$7690$

merci michel
mais il devrait le couper coller et non pas copier coller car cela pose un
probleme il boucle toujours sur le meme fichiers.

merci d'avance.

"MichD" imvtof$869$
OK, seulement à modifier la procédure test comme ceci :

'----------------------------------------
Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory) & ""
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'----------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d936de4$0$32456$

merci
ca a l air de marcher sauf que par exemple il me trouve un fichier
9965.pdf
et mon repertoire "s:9965 rue de paris" existe deja je voudrais qu'il me
copie le pdf dessous justement.

merci d avance


"MichD" imvpl2$sms$
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!




achille
Le #23248331
merci michel ca marche nikel
bravo



"MichD" in1ouj$hc8$
Dans un module standard :

'déclaration API dans le haut du module standard :
'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant
Dim A As Integer, T(), Elt As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
ReDim Preserve T(A)
T(A) = Fichier
A = A + 1
Fichier = Dir()
Loop
For Each Elt In T
Racine = Left(Elt, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory)
CopieDossier Repertoire_A_Scanner & Elt, _
Repertoire_Destination & Racine & "" & Elt, _
xlCopy, True
End If
Next

End Sub
'----------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d9440d8$0$7690$

merci michel
mais il devrait le couper coller et non pas copier coller car cela pose un
probleme il boucle toujours sur le meme fichiers.

merci d'avance.

"MichD" imvtof$869$
OK, seulement à modifier la procédure test comme ceci :

'----------------------------------------
Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory) & ""
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'----------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d936de4$0$32456$

merci
ca a l air de marcher sauf que par exemple il me trouve un fichier
9965.pdf
et mon repertoire "s:9965 rue de paris" existe deja je voudrais qu'il me
copie le pdf dessous justement.

merci d avance


"MichD" imvpl2$sms$
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!







steph b
Le #23275421
Bonjour,
La prcoédure marche super bien..mais comment je pourrais inclure aussi les
sous repertoires????

merci



"MichD" in1ouj$hc8$
Dans un module standard :

'déclaration API dans le haut du module standard :
'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant
Dim A As Integer, T(), Elt As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
ReDim Preserve T(A)
T(A) = Fichier
A = A + 1
Fichier = Dir()
Loop
For Each Elt In T
Racine = Left(Elt, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory)
CopieDossier Repertoire_A_Scanner & Elt, _
Repertoire_Destination & Racine & "" & Elt, _
xlCopy, True
End If
Next

End Sub
'----------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d9440d8$0$7690$

merci michel
mais il devrait le couper coller et non pas copier coller car cela pose un
probleme il boucle toujours sur le meme fichiers.

merci d'avance.

"MichD" imvtof$869$
OK, seulement à modifier la procédure test comme ceci :

'----------------------------------------
Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
Racine = Dir(Repertoire_Destination & Racine & _
"*", vbDirectory) & ""
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'----------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d936de4$0$32456$

merci
ca a l air de marcher sauf que par exemple il me trouve un fichier
9965.pdf
et mon repertoire "s:9965 rue de paris" existe deja je voudrais qu'il me
copie le pdf dessous justement.

merci d avance


"MichD" imvpl2$sms$
Bonjour,


Dans le haut d'un module standard, tu déclares les API
et tu exécutes la procédure "Test" en prenant soin de bien
définir les variables selon ton application.

'---------------------------------------------------
Type SHFILEOPSTRUCT
hwnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAnyOperationsAborted As Boolean
hNameMappings As Long
lpszProgressTitle As String
End Type

Private Declare Function SHFileOperationA Lib "Shell32.dll" _
(lpFileOp As SHFILEOPSTRUCT) As Long

'---------------------------------------------------
Private Function CopieDossier(Source As String, Dest As String, _
Optional Action As Byte, Optional Animation As Boolean) As Boolean
Dim OpStruct As SHFILEOPSTRUCT
If Action > 2 Then Exit Function
With OpStruct
.wFunc = IIf(Action = xlMove, 1, 2)
.pFrom = Source
.pTo = Dest
If Not Animation Then .fFlags = 4
End With
CopieDossier = IIf(SHFileOperationA(OpStruct), False, True)
End Function
'---------------------------------------------------

Sub Test()

Dim Repertoire_A_Scanner As String
Dim Repertoire_Destination As String
Dim Fichier As String, Racine As Variant

Repertoire_Destination = "C:Denis1"
Repertoire_A_Scanner = "c:Denis"

Fichier = Dir(Repertoire_A_Scanner & "*.pdf")

Do While Fichier <> ""
Racine = Left(Fichier, 4)
If IsNumeric(Racine) Then
CopieDossier Repertoire_A_Scanner & Fichier, _
Repertoire_Destination & Racine & "" & Fichier, _
xlCopy, True
End If
Fichier = Dir()
Loop

End Sub
'---------------------------------------------------



MichD
--------------------------------------------
"achille" a écrit dans le message de groupe de discussion :
4d934cf2$0$32453$

Bonjour

J ai un repertoire nommé f:DOSSIER

ce dossier contient des fichiers par exemple
9997.pdf
4578.pdf
8745.pdf
et
1245745256555.pdf

ce ne sont que des exemples bien évidemment

sur un autre repertoire nommé s:NOM D UN REPERTOIRE
il y a des sous répertoires nommés
9997 tartenpion
4578 matante
8745 mononcle

entre les 4 chiffres j'ai obligatoirement un espace, pour information

en fait ce que j aimerais qu une macro me trouve par exemple le fichier
9997.pdf dans le repertoire nommé f:DOSSIER et ensuite me le copie dans
le
repertoire s:NOM D UN REPERTOIRE9997 tartenpion

et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:DOSSIER

merci d avance!







Publicité
Poster une réponse
Anonyme