File Scripting Object
Files
Description: Donne accès aux propriétés d’un fichier.
Note: Le code suivant illustre l’obtention d’un objet File et l’affichage d’une de ses propriétés.
Function ShowDateCreated(filespec)
Dim fso, f
Set fso = CreateObject(« Scripting.FileSystemObject »)
Set f = fso.GetFile(filespec)
ShowDateCreated = f.DateCreated
End Function
Copy
Description: Copie un fichier ou un dossier spécifié d’un emplacement vers un autre.
Notes: Le résultat de la méthode Copy sur un objet File ou Folder est identique à celui de FileSystemObject.CopyFile ou FileSystemObject.CopyFolder où le fichier ou le dossier référencés par object est passé en argument. Notez cependant que ces méthodes alternatives sont capables de copier plusieurs fichiers ou dossiers.
Set fso = CreateObject(« Scripting.FileSystemObject »)
Set a = fso.CreateTextFile(« c:.txt », True)
a.WriteLine(« Ceci est un test. »)
Set a = fso.GetFile(« c:.txt »)
a.Copy (« c:.txt »)
Subfolders
Description: Copie un fichier ou un dossier spécifié d’un emplacement vers un autre.
Notes: Le résultat de la méthode Copy sur un objet File ou Folder est identique à celui de FileSystemObject.CopyFile ou FileSystemObject.CopyFolder où le fichier ou le dossier référencés par object est passé en argument. Notez cependant que ces méthodes alternatives sont capables de copier plusieurs fichiers ou dossiers.
Sub AfficheListeDossier(specdossier)
Dim fs, f, f1, s, sf
Set fs = CreateObject(« Scripting.FileSystemObject »)
Set f = fs.GetFolder(specdossier)
Set sf = f.SubFolders
For Each f1 in sf
s = s & f1.name
s = s & vbCrLf
Next
MsgBox s
End Sub
Explorer tous les sous-dossiers
Dans les références du projet, ajouter
Sub Command1_Click()
Dim fso As New FileSystemObject
ExploreFolder fso.GetFolder(« D:\Toto »)
End Sub
Sub ExploreFolder(fld As Folder)
‘ Interruption
If toto Then Exit Sub
‘ Affiche les fichiers dans le Debug
Dim f As File
For Each f In fld.Files
Debug.Print f.Name
‘ Pour détecter la touche d’arrêt
DoEvents
Next
‘ Traite les sous-dossiers
Dim fld1 As Folder
For Each fld1 In fld.SubFolders
ExploreFolder fld1
Next
End Sub
Récupération de la version d'un fichier
J’ai fait une appli qui utilise cette ressource: Date des fichiers.
Je suis parti de la source:
https://codes-sources.commentcamarche.net/source/638-information-version-type-copyright-description-d-un-fichier-ocx-dll-ou-exe
Taille utilisable de l'écran
Dans un module:
Public Declare Function SystemParametersInfo Lib « user32 » Alias « SystemParametersInfoA » (ByVal uAction As Long, ByVal uParam As Long, ByRef lpvParam As RECT, ByVal fuWinIni As Long) As Long
Public Const SPI_GETWORKAREA = 48
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Function LargeurEcran() As Long
Dim Prect As RECT
If SystemParametersInfo(SPI_GETWORKAREA, 0, Prect, 0) Then
LargeurEcran = (Prect.Right – Prect.Left) * Screen.TwipsPerPixelX
End If
End Function
Public Function HauteurEcran() As Long
Dim Prect As RECT
If SystemParametersInfo(SPI_GETWORKAREA, 0, Prect, 0) Then
HauteurEcran = (Prect.Bottom – Prect.Top) * Screen.TwipsPerPixelY
End If
End Function
Récupération du nom d'un volume
Function RecupereLettreDisque(NomDisque As String)
Dim fs, f, f1, s
Set fs = CreateObject(« Scripting.FileSystemObject »)
Set f = fs.drives
For Each s In f
If s.isready Then
If s.volumeName = NomDisque Then RecupereLettreDisque = s
End If
Next
End Function
Les MRD constantes
‘—————Les codes de couleur
Public Const MrdBlanc As Double = &HFFFFFF
Public Const MrdGrisClair As Double = &HC0C0C0
Public Const MrdGrisFoncé As Long = &H808080
Public Const MrdNoir As Double = &H80000008
Public Const MrdJaunePale As Long = &HC0FFFF
Public Const MrdJaune As Long = &HFFFF&
Public Const MrdSaumon As Long = &HC0C0FF
Public Const MrdOrangePale As Long = &HC0E0FF
Public Const MrdOrange As Double = &H80FF&
Public Const MrdMagenta As Double = &HFF00FF
Public Const MrdRouge As Double = &HFF&
Public Const MrdVertPale As Long = &HC0FFC0
Public Const MrdVertClair As Double = &HFF00&
Public Const MrdVertFoncé As Double = &HC000&
Public Const MrdCyan As Double = &HFFFF00
Public Const MrdBleu As Double = &HFF0000
‘—————Les types de données des champs de MDB
‘for i=0 to data.Recordset.Fields.Count-1:print data.Recordset.Fields(i).Type:next i
Public Const MrdBddNumAuto As Integer = 4
Public Const MrdBddDate As Integer = 8
Public Const MrdBddTexte As Integer = 10
Public Const MrdBddNumeric As Integer = 7
‘—————Les durées pour calcul de décalage
‘Exemple:
If CDbl(CDate(Now) – CDate(ficdate)) > MrdUneHeure Then
Public Const MrdUnAn As Double = 365
Public Const MrdUnMois As Double = 31
Public Const MrdUneSemaine As Double = 7
Public Const MrdUnJour As Double = 1
Public Const MrdUneHeure As Double = 4.16666666715173E-02
Public Const MrdUneMinute As Double = 6.94444439432118E-04
Public Const MrdUneSeconde As Double = 1.15740695036948E-05
‘—————Les codes de touches (keycode)
Public Const MrdKeycodeBackSpace As Integer = 8
Public Const MrdKeycodeTab As Integer = 9
Public Const MrdKeycodeMaj As Integer = 16
Public Const MrdKeycodeCtrl As Integer = 17
Public Const MrdKeycodeAlt As Integer = 18
Public Const MrdKeycodeEsc As Integer = 27
Public Const MrdKeycodeSpace As Integer = 32
Public Const MrdKeycodePageUp As Integer = 33
Public Const MrdKeycodePageDown As Integer = 34
Public Const MrdKeycodeEnd As Integer = 35
Public Const MrdKeycodeHome As Integer = 36
Public Const MrdKeycodeLeft As Integer = 37
Public Const MrdKeycodeUp As Integer = 38
Public Const MrdKeycodeRight As Integer = 39
Public Const MrdKeycodeDown As Integer = 40
Public Const MrdKeycodeIns As Integer = 45
Public Const MrdKeycodeDel As Integer = 46
Public Const MrdKeycodeWin As Integer = 92
Public Const MrdKeycodeF1 As Integer = 112
Mettre une liste de valeurs en tableau
Cette MRD fonction sert à transformer une liste de valeurs en un tableau variant. Le nombre d’éléments de la liste est quelconque.
Function MetValeursEnTableau(ParamArray MesValeurs()) As Variant
Dim Toto()
ReDim Toto(0)
Dim Index As Integer
For Each X In MesValeurs
ReDim Preserve Toto(Index)
Toto(Index) = X
Inc Index
Next X
MetValeursEnTableau = Toto
End Function
Elle s’utilise de la sorte:
Dim Toto as Variant
Toto = MetValeursEnTableau(« Riri », « Fifi », « Loulou »)
Dans l’exemple précédent, on récupère:
Toto(0)= »Riri »
Toto(1)= »Fifi »
Toto(2)= »Loulou »
DateAdd
Permet d’ajouter ou retirer des temps à une date/heure donnée.
Ex:
‘ajoute un mois à l’instant présent.
DateAdd(« m », 1, now)
ExitWindowsEx
Sert à arrêter le PC. J’ai créé un programme qui se sert de cette fonction: ExtinctionPc.exe