1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
| '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
Dim r
Dim 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 répertoire
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(sFile, txt, Optional TxtDefault As String = "")
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(sFile) = False Then EnteteFichier sFile
AppendTxt sFile, txt
Set FSO = Nothing
End Sub
'permet de créer un fichier texte
Private Sub EnteteFichier(Fichier, Optional 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!
Function AppendTxt(sFile, sText)
Dim FSO, NewFichier
Set FSO = CreateObject("Scripting.FileSystemObject")
Set NewFichier = FSO.OpenTextFile(sFile, 8)
NewFichier.Write sText
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 = Split(oFile.ReadAll, vbCrLf)
oFile.Close
End Function |
Utilisation de CreateObject("Scripting.FileSystemObject")
Répondre avec citation
Envoyé par Thierry_PALLIER
Partager