1. Accueil
  2. Visual Basic / VB.NET
  3. Sources Visual Basic / VB.NET
  4. Sources API
  5. Copie batch paramétrée de fichiers , incrémentés.

Copie batch paramétrée de fichiers , incrémentés.

Soyez le premier à donner votre avis sur cette source.

Vue 7 204 fois - Téléchargée 354 fois

Télécharger le projet
Commenter

Description

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
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (cs_Zorglub)