Sauvegarde de fichiers en réponse à un message du forum (filtrage, copie, renommage, trouver numéro de fichier)

Télécharger le projet
Commenter

Description

Cette source est la réponse d'un message de "mauris" sur le forum.
Elle permet de copier tout les fichiers .xls dans un autre dossier et de les renommer en .sav

Bon, c'est sur, cette source n'a aucune prétention, de plus elle est très simple.

Le programme requiert:
- 2 commandbutton appelés BoutCommencer et BoutQuitter
- 1 label appelé TextEtat
- 1 filelistbox appelé File1

Source / Exemple : 


'###############################################################
'programmé par Tioneb pour Mauris
'suite à un message sur vbfrance
'###############################################################

'API qui va nous servir à copier les fichiers
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Public CheminXls As String
Public CheminSav As String
Public NbrXls As Integer, NbrSav As Integer

Private Sub BoutCommencer_Click()
    'on bloque les entrées
    BoutQuitter.Enabled = False
    BoutCommencer.Enabled = False
    'on vérifie que le dossier de destination est vide
    File1.Path = CheminSav
    File1.Pattern = "*.sav"
    NbrSav = File1.ListCount
    If NbrSav <> 0 Then
        'le dossier n'est pas vide!
        If MsgBox("Le dossier " & CheminSav & " n'est pas vide; voulez-vous écraser les fichiers existant?", vbApplicationModal + vbQuestion + vbYesNo, "Question") = vbNo Then
            'l'utilisateur répond non
            MsgBox "L'opération de sauvegarde ne s'est pas effectuée.", vbApplicationModal + vbExclamation + vbOKOnly, "Arrêt prématuré"
            Exit Sub 'on arrête la fonction
        End If
    End If
    'obligatoirement on arrive ici quand l'utilisateur répond oui ou que le dossier de destination est vide
    File1.Path = CheminXls
    File1.Pattern = "*.xls" 'filtre les fichiers
    NbrXls = File1.ListCount 'pour capturer le nombre de fichiers
    Dim i As Integer
    Dim Temp As String
    For i = 0 To NbrXls - 1 '-1 car on commence à compter à partir de 0!
        'boucle de copie
        Temp = File1.List(i) 'on chope le nom du fichier
        TextEtat.Caption = "Traitement de """ & Temp
        Copier CheminXls & Temp, CheminSav & "Files" & TrouverNumFichier(4, i + 1) & ".sav", False 'on le copie et le renomme par la même occasion!
    Next i
    TextEtat.Caption = "Traitement réalisé avec succès"
    'on déverrouille le prog
    BoutQuitter.Enabled = True
    BoutCommencer.Enabled = True
    Beep 'sur certains système ça émet un bip!
End Sub

Private Sub BoutQuitter_Click()
    End
End Sub

Private Sub Form_Load()
    CheminXls = "D:\Data"
    CheminSav = "D:\sauv"
    
    'c'est pour tester chez moi!!!
    'CheminXls = "C:\VB"
    'CheminSav = "C:\VB\sauv"
    
    'vérifier qu'il y a les "\" à la fin du chemin
    If Right(CheminXls, 1) <> "\" Then
        CheminXls = CheminXls & "\"
    End If
    If Right(CheminSav, 1) <> "\" Then
        CheminSav = CheminSav & "\"
    End If
End Sub

Public Function Copier(Source As String, Destination As String, SiExist As Boolean)
    CopyFile Source, Destination, SiExist 'SiExist=True si vous voulez que si le fichier existe déjà, ça s'arrête ou SiExist=False pour écrire sur le fichier existant
End Function

Public Function TrouverNumFichier(CombienChiffre As Integer, NumeroFichier As String) As String
    Dim TNFTemp As Integer
    TNFTemp = CombienChiffre - Len(NumeroFichier) 'il faut ajouter autant de "0" avant le chiffre
    TrouverNumFichier = String(TNFTemp, "0") & NumeroFichier 'et on renvoi le numéro précédé du bon nombre de "0"
End Function

Conclusion :


Merci de ne pas mettre de commentaires dans le genre: "ça sert à rien", ou "c'est nul". Je me répette: ce code est la réponse à un message de mauris.
D'ailleurs, dis moi si ça te convient
Télécharger le projet

Codes Sources

A voir également

Du même auteur (cs_Tioneb)