|
' renvoie la taille en octets du dossier dirPath (recursif par défaut) |
|
' si dirPath est un fichier, renvoie la taille du fichier |
|
Function getDirSize(ByVal dirPath As String, Optional ByVal recursive As Boolean = True) As Long |
|
Set OFS = CreateObject("Scripting.FileSystemObject") |
|
' si dirPath est bien un dossier |
|
If OFS.FolderExists(dirPath) Then |
|
Set objFiles = OFS.GetFolder(dirPath).Files |
|
' on somme les fichiers |
|
somme = 0 |
|
For Each f In objFiles |
|
Set oFO = OFS.GetFile(f.Path) |
|
somme = somme + oFO.Size |
|
Next f |
|
' on somme récursivement les dossiers si recursive |
|
If recursive Then |
|
Set oo = OFS.GetFolder(dirPath) |
|
Set objFolders = OFS.GetFolder(dirPath).SubFolders |
|
For Each d In objFolders |
|
somme = somme + getDirSize(d.Path, recursive) |
|
Next d |
|
End If |
|
getDirSize = somme |
|
' si dirPath est un fichier |
|
ElseIf OFS.fileExists(dirPath) Then |
|
Set oFO = OFS.GetFile(filePath) |
|
getDirSize = oFO.Size |
|
Else |
|
getDirSize = 0 |
|
End If |
|
End Function |
|
Sub unittest_getDirSize() |
|
d = GetFolder() |
|
Dim n As Long |
|
n = getDirSize(d, True) |
|
Debug.Print n / (CLng(1024) * CLng(1024)) & " Mo" |
|
End Sub |
|
|
|
' renvoie la taille en octets du fichier |
|
Function getFileSize(ByVal filePath As String) As Long |
|
If fileExists(filePath) Then |
|
Set OFS = CreateObject("Scripting.FileSystemObject") |
|
Set oFO = OFS.GetFile(filePath) |
|
getFileSize = oFO.Size |
|
End If |
|
End Function |
|
Sub unittest_getFileSize() |
|
f = GetFile() |
|
n = getFileSize(f) |
|
End Sub |
|
|
|
' requires reference to Microsoft ADO |
|
Function readFile(ByVal filePath As String, Optional ByVal encoding As String = "utf-8") |
|
Dim objStream, strData |
|
Set objStream = CreateObject("ADODB.Stream") |
|
objStream.Charset = encoding |
|
objStream.Open |
|
objStream.LoadFromFile (filePath) |
|
readFile = objStream.ReadText() |
|
objStream.Close |
|
Set objStream = Nothing |
|
End Function |
|
|
|
' auto-porteur :) |
|
Function fileExists(ByVal fichier As String) As Boolean |
|
'fileExists = (Dir$(fichier, vbNormal) <> "") And (fichier <> "") ' marche aussi mais inspire moins confiance |
|
Set OFS = CreateObject("Scripting.FileSystemObject") |
|
fileExists = OFS.fileExists(fichier) |
|
End Function |
|
|
|
' affiche la boîte de dialogue pour choisir un dossier |
|
Function GetFolder(Optional strpath As String = "") As String |
|
Dim fldr As FileDialog |
|
Dim sItem As String |
|
Set fldr = Application.FileDialog(msoFileDialogFolderPicker) |
|
With fldr |
|
.Title = "Select a Folder" |
|
.AllowMultiSelect = False |
|
If strpath <> "" Then .InitialFileName = strpath |
|
If .Show <> -1 Then GoTo NextCode |
|
sItem = .SelectedItems(1) |
|
End With |
|
NextCode: |
|
GetFolder = sItem |
|
Set fldr = Nothing |
|
End Function |
|
|
|
' affiche la boîte de dialogue pour choisir un fichier |
|
Function GetFile(Optional strpath As String = "") As String |
|
Dim fldr As FileDialog |
|
Dim sItem As String |
|
Set fldr = Application.FileDialog(msoFileDialogFilePicker) |
|
With fldr |
|
.Title = "Select a File" |
|
.AllowMultiSelect = False |
|
If strpath <> "" Then .InitialFileName = strpath |
|
If .Show <> -1 Then GoTo NextCode |
|
sItem = .SelectedItems(1) |
|
End With |
|
NextCode: |
|
GetFile = sItem |
|
Set fldr = Nothing |
|
End Function |
|
|
|
' renvoie le nom du fichier à partir de son chemin, en gardant l'extension |
|
Function basename(ByVal inVal As String, Optional directorySeparater As String = "\") As String |
|
Dim Index As Integer |
|
|
|
Index = InStrRev(inVal, directorySeparater) |
|
If Index > 0 Then |
|
basename = Mid(inVal, Index + 1) |
|
Else |
|
basename = Mid(inVal, Index + 1) |
|
End If |
|
End Function |
|
|
|
' renvoie le dossier parent |
|
Function parentFolder(ByVal p As String) As String |
|
If Len(p) > 1 Then |
|
If Right(p, 1) = "\" Then |
|
p = Left(p, Len(p) - 1) |
|
End If |
|
parentFolder = getLastSlash(p, "") |
|
End If |
|
End Function |
|
|
|
' fonction auxiliaire pour parentFolder qui renvoie le dossier parent d'un chemin |
|
Function getLastSlash(ByVal restant As String, ByVal res As String) |
|
n = InStr(restant, "\") |
|
If n > 0 Then |
|
getLastSlash = getLastSlash(Right(restant, Len(restant) - n), res & Left(restant, n)) |
|
Else |
|
getLastSlash = res |
|
End If |
|
End Function |
|
|
|
'You can use this to delete all the files in the folder mondossier |
|
Sub cleanFolder(ByVal mondossier As String) |
|
On Error Resume Next |
|
Kill mondossier & "\*.*" |
|
On Error GoTo 0 |
|
End Sub |
|
|
|
' renvoie l'url du fichier trouvé dans le dossier avec les motcles (non recursif) |
|
' opt = first|last|mostrecent |
|
Function chercheFichier(ByVal dossier As String, ByVal motscle As Variant, Optional ByVal opt As String = "first") As String |
|
Set fso = CreateObject("Scripting.FileSystemObject") |
|
|
|
If Dir(dossier, vbDirectory) = "" Then Exit Function ' on quitte si le dossier n'existe pas |
|
Set objFiles = fso.GetFolder(dossier).Files |
|
Set res = New Collection |
|
Dim maxdate, ladate As Date |
|
|
|
For Each f In objFiles |
|
' si ça existe on crée le lien |
|
If InStr(f.Name, "~") = 0 Then |
|
ok = True |
|
For j = 0 To UBound(motscle) |
|
'If InStr(LCase(f.Name), LCase(motscle(j))) = 0 Then ok = False |
|
tmpre = RegexMatch(LCase(motscle(j)), LCase(f.Name)) |
|
If tmpre = "" Then ok = False |
|
Next j |
|
If ok Then |
|
chercheFichier = f.Path |
|
If opt = "first" Then |
|
Exit Function |
|
ElseIf opt = "mostrecent" Then |
|
res.Add f.Path |
|
End If |
|
End If |
|
End If |
|
Next f |
|
|
|
If opt = "mostrecent" Then |
|
If res.Count > 0 Then |
|
chercheFichier = res(1) |
|
maxdate = getLastModifDate(res(1)) |
|
For i = 2 To res.Count |
|
ladate = getLastModifDate(res(i)) |
|
If maxdate < ladate Then |
|
chercheFichier = res(i) |
|
maxdate = ladate |
|
End If |
|
Next i |
|
End If |
|
End If |
|
End Function |
|
|
|
' renvoie la date de dernière modification d'un fichier |
|
Function getLastModifDate(ByVal f As String) As Date |
|
'Instanciation du FSO |
|
Set oFSO = CreateObject("Scripting.FileSystemObject") |
|
'Instanciation de l'objet File |
|
If oFSO.fileExists(f) Then |
|
Set oFl = oFSO.GetFile(f) |
|
getLastModifDate = oFl.DateLastModified |
|
End If |
|
End Function |
|
|
|
' dit si le dossier existe ou non |
|
Function isDir(ByVal chemin As String) As Boolean |
|
'isDir = chemin <> "" And (Dir(chemin, vbDirectory) <> "") ' marche aussi mais inspire moins confiance |
|
Set OFS = CreateObject("Scripting.FileSystemObject") |
|
isDir = OFS.FolderExists(chemin) |
|
End Function |
|
|
|
' renvoie tous les fichiers récursivement situés dans chemin |
|
' en option on peut spécifier une regex pour filtrer uniquement certains fichiers |
|
Function getFiles(ByVal chemin As String, Optional ByVal re As String = "") As Collection |
|
Dim FileSystem As Object |
|
Dim c As Collection |
|
Set c = New Collection |
|
|
|
Set FileSystem = CreateObject("Scripting.FileSystemObject") |
|
DoFolder FileSystem.GetFolder(chemin), re, c |
|
Set getFiles = c |
|
End Function |
|
|
|
' fonction auxiliaire de getFiles |
|
Sub DoFolder(Folder, ByVal re As String, ByRef res As Collection) |
|
Dim SubFolder |
|
For Each SubFolder In Folder.SubFolders |
|
DoFolder SubFolder, re, res |
|
Next |
|
Dim File |
|
For Each File In Folder.Files |
|
If re = "" Or RegexMatch(re, File.Name) <> "" Then |
|
res.Add File.path |
|
End If |
|
Next |
|
End Sub |