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!
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$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
merci d avance!
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!
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!
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$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
merci d avance!
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!
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!
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!
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!
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" 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
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!
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$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
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$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
merci d avance!
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" 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
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!
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
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" 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
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!
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
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$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
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$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
merci d avance!
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
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" 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
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!
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!
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!
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!
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" 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
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!
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$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
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$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
merci d avance!
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" 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
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!
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" 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
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" 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
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!
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$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
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$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
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$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
merci d avance!
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" 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
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" 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
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!
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" 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
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" 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
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!
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$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
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$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
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$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
merci d avance!
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" 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
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" 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
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!