dysorthographie
XLDnaute Accro
Tout ce que vous vouliez savoir sur FSOsans avoir osé le demander!
VB:
'Permet de vérifier si le répertoire dont le nom est précisé en paramêtre (Repertoires) existe. Retourne True s'il existe, sinon False
Public Function Repertoires_Existe(Repertoires)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Repertoires_Existe = FSO.FolderExists(Repertoires)
Set FSO = Nothing
End Function
'Taille d'un répertoire
Public Function Taille_Repertoire(Repertoire)
Dim FSO
Dim Rep
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Rep = FSO.GetFolder(Repertoire)
Taille_Repertoire = Rep.Size
End Function
Function Repertoire_Date_Creation(Repertoire)
Dim FSO
Dim Rep
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Rep = FSO.GetFolder(Repertoire)
Repertoire_Date_Creation = Rep.DateCreated
End Function
'Crée un répertoire, dont l'emplacement et le nom sont précisé par le chemin d'accês complet précisé en argument (NewRepertoires).
Public Sub Creer_Repertoires(NewRepertoires)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim t, r, I
r = ""
t = Split(NewRepertoires & "\", "\")
For I = 0 To UBound(t) - 1
If Trim("" & t(I)) <> "" Then
r = r & Trim("" & t(I))
If Repertoires_Existe(r) = False Then FSO.CreateFolder "" & r
End If
r = r & "\"
Next
Set FSO = Nothing
End Sub
'Copie un répertoire, ainsi que tous les fichiers et sous-répertoires qu'il contient, d'une source vers une destination.
Public Sub Copie_Repertoires(Source, Destination)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFolder Source, Destination, True
Set FSO = Nothing
End Sub
'Déplace un ou plusieurs répertoire d'un emplacement source vers une destination.
Public Function Deplace_Repertoire(Source, Destination)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
FSO.MoveFolder Source, Destination
If Err > 0 Then Deplace_Repertoire = Err.Description
Err.Clear
On Error GoTo 0
Set FSO = Nothing
End Function
'Permet de supprimer un répertoire et tous les fichiers et sous-répertoires qu'il contient.
Public Sub Supprimer_Repertoire(DelRepertoire)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.DeleteFolder DelRepertoire, True
Set FSO = Nothing
End Sub
'Taille d'un fichier
Public Function Taille_Fichier(Fichier)
Dim FSO
Dim Fich
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Fich = FSO.GetFile(Fichier)
Taille_Fichier = Fich.Size
End Function
'Vérifie lexistance d'un fichier
Public Function Fichier_Exist(Fichier)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
Fichier_Exist = FSO.FileExists(Fichier)
Set FSO = Nothing
End Function
'Retourne le nom du fichier, à partir du chemin d'accês complet précisé en paramêtre.
Public Function Fichier_Name(Fichier)
Dim FSO
If Fichier_Exist(Fichier) = True Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Fichier_Name = FSO.GetBaseName(Fichier)
Set FSO = Nothing
End If
End Function
'Retourne l'extension du fichier, à partir du chemin d'accês complet précisé en paramêtre.
Public Function Fichier_extension(Fichier)
Dim FSO
If Fichier_Exist(Fichier) = True Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Fichier_extension = FSO.GetExtensionName(Fichier)
Set FSO = Nothing
End If
End Function
'Copie un fichier d'une source vers une destination.
Public Sub Copie_Fichier(Source, Destination)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.CopyFile Source, Destination, True
Set FSO = Nothing
End Sub
'Déplace un ou plusieurs fichiers d'un emplacement source vers une destination.
Public Sub Deplace_Fichier(Source, Destination)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If Fichier_Exist(Source) And Not Fichier_Exist(Destination) Then FSO.MoveFile Source, Destination
Set FSO = Nothing
End Sub
'Supprime le ou les fichiers dont le nom est précisé en argument.
Public Sub Supprimer_Fichier(DelFichier)
If Fichier_Exist(DelFichier) = True Then
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
FSO.DeleteFile DelFichier, True
Set FSO = Nothing
End If
End Sub
Public Sub FichierText(Fichier, txt, Optional TxtDefault As String = "")
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(Fichier) = False Then EnteteFichier Fichier, TxtDefault
AppendTxt Fichier, txt
Set FSO = Nothing
End Sub
'permet de créer un fichier texte
Private Sub EnteteFichier(Fichier, TxtDefault As String)
Dim FSO, NewFichier
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFichier = FSO.OpenTextFile(Fichier, 2, True)
NewFichier.Write TxtDefault
NewFichier.Close
Set NewFichier = Nothing
Set FSO = Nothing
End Sub
'Ajoute txte dans un fichier existant!
Public Function AppendTxt(Fichier, txt)
Dim FSO, NewFichier
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFichier = FSO.OpenTextFile(Fichier, 8)
NewFichier.Write txt
NewFichier.Close
Set NewFichier = Nothing
Set FSO = Nothing
End Function
'retourne un fichier texte sous forme de tableau
Public Function OuvrirFichier(Fichier)
Set oFs = CreateObject("Scripting.FileSystemObject")
Set oFile = oFs.OpenTextFile(Fichier)
OuvrirFichier = oFile.ReadAll
oFile.Close
End Function
Dernière modification par un modérateur:
