Utile pour gérer des images par ex., ce pgm permet la copie à la volée de fichiers d'1 repertoire vers un autre, en respectant les extensions, mais en renommant les fichiers, avec un nombre incrémenté, sur x position, à partir d'un nombre y. Idéal pour les photographes qui mettent leurs photos sur CDrom...
Tout est dans le zip, merci de me prévenir de tte amélioration, et de m'indiquer comment faire un 'rename'. oli.claude@infonie.fr
Source / Exemple :
Option Explicit
Dim NbList As Integer
Dim TransfText As String
Dim Numdeb As String
Dim Numfin As String
Dim Numfin9 As Integer
Dim Indx As Integer
Dim I1 As Integer
Dim FiccopyS As String
Dim FiccopyD As String
Private Sub Cmdren_Click()
'On Error GoTo CopyError
'MsgBox File1.ListCount
File1.ListIndex = -1
For Indx = 1 To File1.ListCount
File1.ListIndex = File1.ListIndex + 1
' Fichier Source
FiccopyS = Dir1.Path & "\" & File1.FileName
' Fichier Destination
Numfin9 = Text3.Text + Indx - 1
Numfin = Numfin9
Numfin = Left("00000000000000000000000000", Text5.Text - Len(Numfin)) + Numfin
' Recherche de la position du point pour avoir l'extension
I1 = Len(File1.FileName)
Do Until Mid$(File1.FileName, I1, 1) = "."
I1 = I1 - 1
Loop
I1 = Len(File1.FileName) - I1
FiccopyD = Dir2.Path & "\" & Text2.Text & Numfin & "." & Right(File1.FileName, I1)
' MsgBox "Copie de " & FiccopyS & " => " & FiccopyD
FileCopy FiccopyS, FiccopyD
Next Indx
MsgBox "OK, " & TransfText & " fichiers copiés !"
'avoir la nouvelle liste !? comment !?
'Dir1.Path = Drive1.Drive
'TransfText = Str$(File1.ListCount)
'Label6.Caption = TransfText + " fichiers."
Exit Sub
CopyError:
MsgBox "Erreur de copie de fichiers !?"
Resume
End Sub
Private Sub Cmdvérif_Click()
Numdeb = Left("00000000000000000000000000", Text5.Text - Len(Text3.Text)) + Text3.Text
Numfin9 = Text3.Text + File1.ListCount - 1
Numfin = Numfin9
Numfin = Left("00000000000000000000000000", Text5.Text - Len(Numfin)) + Numfin
Label6.Caption = "Copie des " + TransfText + " fichiers de " + Dir1.Path + "\" + Text1.Text + " vers"
Label5.Caption = Dir2.Path + "\" + Text2.Text + Numdeb + ".*" + " à " + Text2.Text + Numfin + ".*"
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
TransfText = Str$(File1.ListCount)
Label6.Caption = TransfText + " fichier(s)."
Label5.Caption = " "
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
TransfText = Str$(File1.ListCount)
Label6.Caption = TransfText + " fichier(s)."
Label5.Caption = " "
End Sub
Private Sub Drive2_Change()
Dir2.Path = Drive2.Drive
End Sub
Private Sub Form_Load()
'Filtre
Text1.Text = "*.*"
File1.Pattern = Text1.Text
'Dir1.Path = "D:\Mesdocs\Images\z leo"
'Dir2.Path = "D:\Mesdocs\Images\z leo"
NbList = 0
TransfText = Str$(File1.ListCount)
Label6.Caption = TransfText + " fichier(s)."
Label5.Caption = " "
End Sub
Private Sub Text1_Change()
File1.Pattern = Text1.Text
TransfText = Str$(File1.ListCount)
Label6.Caption = TransfText + " fichier(s)."
Label5.Caption = " "
End Sub
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.