accesstoolbox/source/modules/AT_FileOp.bas

Option Compare Database
Option Explicit

' ** Access Toolbox Module **
' on 2017-02-28,
' @author: Olivier Massot
' V 1.0

' Various file operations

Public Function norm_path(ByVal path As String) As String

    path = replace(path, "/", "\")
    Do Until path = replace(path, "\\", "\")
        path = replace(path, "\\", "\")
    Loop
    norm_path = path
    
End Function

Public Function norm_dir_path(ByVal dir_path As String) As String
    
    dir_path = norm_path(dir_path)
    If Right(dir_path, 1) <> "\" Then dir_path = dir_path & "\"
    norm_dir_path = dir_path

End Function

Public Function joinpaths(ByVal path1 As String, ByVal path2 As String) As String

    path1 = norm_path(path1)
    path2 = norm_path(path2)
    If Not Right(path1, 1) = "\" Or Left(path2, 1) = "\" Then
        path1 = path1 & "\"
    End If
    joinpaths = path1 & path2

End Function

Public Function dir_exists(ByVal dir_path As String) As Boolean

    dir_exists = Dir(norm_dir_path(dir_path), vbDirectory) <> ""

End Function

Public Function file_exists(ByVal file_path As String) As Boolean

    file_exists = Dir(norm_path(file_path)) <> ""

End Function

Public Sub mktree(ByVal dirpath As String)
'recursively create the directory if it does not exist
    On Error GoTo err
    Dim path_part, current_path As String
    current_path = ""
    dirpath = norm_dir_path(dirpath)
    
    If Dir(dirpath, vbDirectory) <> "" Then Exit Sub
    
    For Each path_part In Split(dirpath, "\")
        If Len(path_part) > 0 Then
            current_path = current_path & path_part & "\"
            If Dir(current_path, vbDirectory) = "" Then
                MkDir current_path
            End If
        End If
    Next path_part
    
    Exit Sub
err:
    If err.number = 75 Then
        'dir already exist
    Else
        logger "MkDirIfNotExist", "ERROR", "Unable to create directory " & dirpath & " : " & err.Description
    End If
End Sub

Public Function parent_dir(path As String) As String
    
    parent_dir = CreateObject("Scripting.FileSystemObject").GetParentFolderName(path)
    
    'OR parent_dir = Left(path, InStrRev(path, "\", Len(path) - 1))
End Function

Public Function file_name(path As String) As String
    
    file_name = CreateObject("Scripting.FileSystemObject").GetBaseName(path)
    
    'OR file_name = Split(cheminFichier, "\")(UBound(Split(cheminFichier, "\")))
End Function

Public Function abs_path(path As String) As String
'returns the absolute path
    
    abs_path = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(path)
    
End Function

Public Sub del_if_exist(ByVal path As String)
'delete a file if it exists
    If Dir(path) <> "" Then
        Kill path
    End If
End Sub

Public Function list_files_in(ByVal dirpath As String, Optional ByVal filter As String = "")
    Dim filename As String
    list_files_in = ""
    
    dirpath = norm_dir_path(dirpath)
    
    filename = Dir$(dirpath & filter)
    
    Do Until Len(filename) = 0
        If Len(list_files_in) > 0 Then list_files_in = list_files_in & "|"
        
        list_files_in = list_files_in & filename
        
        filename = Dir$()
    Loop
    
End Function

Public Function read_file(filePath As String, Optional encoding As String = "utf-8") As String
    Dim objStream As ADODB.Stream
    Set objStream = New ADODB.Stream

    objStream.Charset = encoding
    objStream.Open
    objStream.LoadFromFile (filePath)
    ReadFile = objStream.ReadText()
    
    objStream.Close
    Set objStream = Nothing
End Function

Public Sub make_file(filePath As String, content As String, Optional encoding As String = "utf-8")
    Dim objStream As ADODB.Stream
    
    Set objStream = CreateObject("ADODB.Stream")
    objStream.Open
    objStream.Type = 2 'Text
    objStream.Charset = encoding
    objStream.WriteText content
    objStream.SaveToFile (filePath)
    objStream.Close

End Sub

' Generate Random / Unique tempprary file name.
Public Function temp_filename(Optional ByVal sPrefix As String = "tmp") As String
    Dim sTmpPath As String * 512
    Dim sTmpName As String * 576
    Dim nRet As Long
    Dim sFileName As String
    
    nRet = getTempPath(512, sTmpPath)
    nRet = getTempFileName(sTmpPath, sPrefix, 0, sTmpName)
    If nRet <> 0 Then sFileName = Left$(sTmpName, InStr(sTmpName, vbNullChar) - 1)
    TempFile = sFileName
    
End Function

Public Function is_valid_filename(ByVal sName As String) As Boolean
    'returns True if sName is a valid file's name
    
    IsValidFileName = (InStr(sName, "\") = 0 And InStr(sName, "/") = 0 And InStr(sName, "*") = 0 And InStr(sName, "?") = 0 And InStr(sName, Chr(34)) = 0 And InStr(sName, "|") = 0 And InStr(sName, ":") = 0 And InStr(sName, ">") = 0 And InStr(sName, "<") = 0)
                        
End Function

Public Function run_file(filePath As String, Optional args As String = "")

    Shell "cmd.exe /r start " & filePath & " " & args, vbHide

End Function

Public Sub open_file(filePath As String)

    Application.FollowHyperlink filePath

End Sub