0/5 (3 avis)
Vue 5 019 fois - Téléchargée 459 fois
'############################################################### '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
25 juil. 2006 à 11:39
20 oct. 2005 à 14:29
16 juil. 2005 à 18:55
Mille merci à toi, je viens de testé la sur mon Pc perso, ca fonctionne impecablement !
En plus bien commenté pour que je comprenne, extra ;)
Les personnes aussi sympas que toi se font rares !!
Encore merci à toi pour ton excelent taff ;)
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.