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 REPERTOIRE\9997 tartenpion
et ainsi de suite dès qu 'il trouve un fichier de 4chiffres.pdf sous
f:\DOSSIER
Est-ce que tous tes sous-répertoires de destination sont déjà présents dans le répertoire de destination ? Veux-tu reproduire la même structure hiérarchique des répertoires dans le répertoire de destination comme dans ton répertoire source ?
Tu veux pouvoir copier le fichier, donnes un petit exemple de ce que tu désires :
C:Sourcealex1255 totoMonFichier.pdf dans c:DestinationAlex1255 totoMonFichier.pdf
MichD -------------------------------------------- "steph b" a écrit dans le message de groupe de discussion : 4da2d243$0$7700$
Bonjour, La prcoédure marche super bien..mais comment je pourrais inclure aussi les sous repertoires????
merci
"MichD" a écrit dans le message de news: 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
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" a écrit dans le message de news: 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
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" a écrit dans le message de news: 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
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!
Explique un peu
Est-ce que tous tes sous-répertoires de destination sont déjà présents dans le répertoire de destination ?
Veux-tu reproduire la même structure hiérarchique des répertoires dans le répertoire de destination comme dans ton
répertoire source ?
Tu veux pouvoir copier le fichier, donnes un petit exemple de ce que tu désires :
C:Sourcealex1255 totoMonFichier.pdf dans c:DestinationAlex1255 totoMonFichier.pdf
MichD
--------------------------------------------
"steph b" a écrit dans le message de groupe de discussion : 4da2d243$0$7700$ba4acef3@reader.news.orange.fr...
Bonjour,
La prcoédure marche super bien..mais comment je pourrais inclure aussi les
sous repertoires????
merci
"MichD" <michdenis@hotmail.com> a écrit dans le message de news:
in1ouj$hc8$1@speranza.aioe.org...
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
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$ba4acef3@reader.news.orange.fr...
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" <michdenis@hotmail.com> a écrit dans le message de news:
imvtof$869$1@speranza.aioe.org...
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
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$ba4acef3@reader.news.orange.fr...
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" <michdenis@hotmail.com> a écrit dans le message de news:
imvpl2$sms$1@speranza.aioe.org...
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
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$ba4acef3@reader.news.orange.fr...
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
Est-ce que tous tes sous-répertoires de destination sont déjà présents dans le répertoire de destination ? Veux-tu reproduire la même structure hiérarchique des répertoires dans le répertoire de destination comme dans ton répertoire source ?
Tu veux pouvoir copier le fichier, donnes un petit exemple de ce que tu désires :
C:Sourcealex1255 totoMonFichier.pdf dans c:DestinationAlex1255 totoMonFichier.pdf
MichD -------------------------------------------- "steph b" a écrit dans le message de groupe de discussion : 4da2d243$0$7700$
Bonjour, La prcoédure marche super bien..mais comment je pourrais inclure aussi les sous repertoires????
merci
"MichD" a écrit dans le message de news: 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
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" a écrit dans le message de news: 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
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" a écrit dans le message de news: 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
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
