DOC_LIB_FILES.md

Documentation LIB_FILES

TODO : ajouter la fonction Unzip (à nettoyer depuis Inventaire.xlsm)

Liste des fonctions

• getDirsize : (dirPath, optional recursive = True) renvoie la taille du dossier en octets
• getFileSize : (filePath) renvoie la taille du fichier en octets
• readFile : (filePath, optional encoding = "utf-8") renvoie le contenu du fichier
• fileExists : indique si le fichier existe
• GetFile : ouvre une boîte de dialogue pour choisir un fichier et renvoie le chemin
• GetFolder : ouvre une boîte de dialogue pour choisir un dossier
• basename : renvoie le nom du fichier avec son extension à partir du chemin
• parentFolder : renvoie le chemin du dossier parent
• cleanFolder : supprime le contenu d'un dossier (non récursif)
• chercheFichier : cherche un fichier à partir de mots-clé (non récursif)
• getLastModifDate : renvoie la date de dernière modification d'un fichier
• getFiles : renvoie tous les fichiers récursivement situés dans chemin

fileExists

Function fileExists(ByVal fichier As String) as Boolean

GetFolder

Affiche la boîte de dialogue pour choisir un dossier.

Function GetFolder(Optional strpath As String = "") As String

GetFile

Affiche la boîte de dialogue pour choisir un fichier.

Function GetFile(Optional strpath As String = "") As String

basename

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

parentFolder

Renvoie le dossier parent à partir du chemin.

Function parentFolder(ByVal p As String) As String

cleanFolder

You can use this to delete all the files in the folder mondossier. Non récursif.

Sub cleanFolder(ByVal mondossier As String)

chercheFichier

Renvoie l'url du fichier trouvé dans le dossier avec les motcles (non recursif) Option : first|last|mostrecent

Function chercheFichier( _
      ByVal dossier As String, _
      ByVal motscle As Variant, _
      Optional ByVal opt As String = "first") As String

getLastModifDate

Renvoie la date de dernière modification d'un fichier à partir de son chemin.

Function getLastModifDate(ByVal f As String) As Date

isDir

Dit si le dossier existe ou non.

Function isDir(ByVal chemin As String) As Boolean

getFiles

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

LIB_FILES.vbs

' 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