FixPath, IsThere, IsThere1, GetPapa, GetSon

Set of 5 functions to deal with filesystem.
Gets current workbook path, searches for a file in certain folder.
5 of my most important functions since 2002

Edit 2021-08-11: Adding ability to remove separator if found at end of path, to get actual Son in GetSon_Sep

Edit 2021-01-12: After few issues with files inside OneDrive, we have now the FixPath that worked on all variations (Local, OneDrive Personal or OneDrive Business), this one had ToolPath embedded in it

Edit 2020-09-30: Another issue fixed in FixPath when running from for SharePoint folders
Edit 2020-09-19: Adding ability for FixPath to get physical path if workbook is in OneDrive, or force getting the URL instead, parameter URL_ifOneDrive


Public

Tested

My Own Work
'        =========== FixPath
'        Description: Fixes the path for a given folder, PC or Mac, Also can gets the path for the current workbook
Function FixPath(Optional InPath = "This", Optional Seperater = "FolderAuto_PC_or_Mac")
    ' To Fix the path as needed, always put the '\' at end ...
    ' In The Name of Allah
    ' FixPath (add the '\' character (: for Mac) to the end of string or not) (Anmar Moheddin File1@uruklink.net)
    Sepa = "\"
    If Seperater = "FolderAuto_PC_or_Mac" Then
        Sepa = "/"
        If Application.OperatingSystem Like "*Mac*" Then Sepa = ":"
        If URL_ifOneDrive = 0 Then
            If Seperater = "FolderAuto_PC_or_Mac" Then
                Sepa = "\"
                If Application.OperatingSystem Like "*Mac*" Then Sepa = ":"
            End If
        End If
    Else
        Sepa = Seperater
    End If
    If InPath = "This" Then
        InPath = ThisWorkbook.Path
        If UCase(Left(InPath, 4)) = "HTTP" Then
            InPath = ThisWorkbook.FullName
            Dim Fso1
            Set Fso1 = CreateObject("Scripting.FileSystemObject")
            ' Assume it is Consumer OneDrive (There are usually 4 slashes "\" from start of http to root folder)
            InPath = Replace(InPath, "/", Sepa) ' it is URL, so let us replace those
            For Ctr = 1 To 4
                InPath = Mid(InPath, InStr(InPath, Sepa) + 1)
            Next
            ' Checks for the file
            If Fso1.fileexists(Environ("OneDriveConsumer") & Sepa & InPath) Then
                InPath = Environ("OneDriveConsumer") & Sepa & GetPapa(InPath)
            ElseIf Fso1.fileexists(Environ("OneDrive") & Sepa & InPath) Then
                InPath = Environ("OneDrive") & Sepa & GetPapa(InPath)
            Else
                For Ctr = 1 To 2
                    InPath = Mid(InPath, InStr(InPath, Sepa) + 1)
                Next
                ' Oops, it is Commercial onedrive. There are usually 6 slashes "\" from start of http to the folder we are calling, let us test that
                If Fso1.fileexists(Environ("OneDriveCommercial") & Sepa & InPath) Then
                    InPath = Environ("OneDriveCommercial") & Sepa & GetPapa(InPath)
                ElseIf Fso1.fileexists(Environ("OneDrive") & Sepa & InPath) Then
                    InPath = Environ("OneDrive") & Sepa & GetPapa(InPath)
                Else
                    InPath = "N/A"
                End If
            End If
            Set Fso1 = Nothing
        End If
    End If
    If Right(InPath, 1) <> Sepa Then InPath = InPath & Sepa
    FixPath = InPath
End Function

'        =========== GetPapa and GetSon with all variations
Function GetSon(FullPath)
    GetSon = GetSon_Sep(FullPath)
End Function
Function GetPapa(Optional FullPath = "This")
    If FullPath = "This" Then FullPath = ThisWorkbook.Path
    GetPapa = GetPapa_Sep(FullPath)
End Function
Function GetSon_URL(FullPath)
    GetSon_URL = GetSon_Sep(FullPath, "/")
End Function
Function GetPapa_URL(FullPath)
    GetPapa_URL = GetPapa_Sep(FullPath, "/")
End Function
Function GetSon_Sep(FullPath, Optional Separator = "\")
    ' Reads the son of a string based on certain separator, default is \ for file path
    If Application.OperatingSystem Like "*Mac*" And Separator = "\" Then Seperater = ":"
    If UCase(Right(FullPath, Len(Separator))) = UCase(Separator) Then
        lastslash = InStrRev(Left(FullPath, Len(FullPath) - Len(Separator)) , Separator)
    Else
        lastslash = InStrRev(FullPath, Separator)
    End If
    GetSon_Sep = Mid(FullPath, lastslash + 1)
End Function
Function GetPapa_Sep(FullPath, Optional Separator = "\")
    If Application.OperatingSystem Like "*Mac*" And Separator = "\" Then Seperater = ":"
    lastslash = InStrRev(FullPath, Separator)
    GetPapa_Sep = FullPath
    If lastslash > 0 Then GetPapa_Sep = Left(FullPath, lastslash - 1)
End Function

'        =========== IsThere+IsThere1 (wild cards)
'        Description: Searches for a file in a folder, Accepts wildcards
Public Function IsThere(FileN, Optional InFolder = "This", Optional Hidden _
As Boolean = False, Optional System As Boolean = False, _
Optional Directory As Boolean = False) As Boolean
'    Searchs for a file in a specified folder with a specified attribute
'    By 'Dir' Command
    If InFolder = "This" Then InFolder = FixPath() ' ThisWorkbook.Path ' In Excel
    IsThere = False
    If Hidden Then Attr = Attr + vbHidden
    If System Then Attr = Attr + vbSystem
    If Directory Then Attr = Attr + vbDirectory
    On error goto byebye
    di=""
    di = Dir(FixPath(InFolder) & FileN, Attr)
    If di = "" Then GoTo ByeBye
    If InStr(1, FileN, "*") > 0 Or InStr(1, FileN, "?") > 0 Then
        If di = "." Or di = ".." Then GoTo ByeBye
        IsThere = True
    Else
        Do Until di = ""
            If UCase(di) = UCase(FileN) Then
                IsThere = True
                Exit Do
            End If
            di = Dir
        Loop
    End If
ByeBye:
    on error goto 0
End Function

Public Function IsThere1(FullFileN, Optional Hidden As Boolean = False, Optional System As Boolean = False, _
    Optional Directory As Boolean = False) As Boolean
'    Searchs for a file in a specified folder with a specified attribute
'    By 'Dir' Command
    IsThere1 = False
    FileN = GetSon(FullFileN)
    If Hidden Then Attr = Attr + vbHidden
    If System Then Attr = Attr + vbSystem
    If Directory Then Attr = Attr + vbDirectory
    on error goto byebye
    di=""
    di = Dir(FullFileN, Attr)
    If di = "" Then GoTo ByeBye
    If InStr(1, FileN, "*") > 0 Or InStr(1, FileN, "?") > 0 Then
        If di = "." Or di = ".." Then GoTo ByeBye
        IsThere1 = True
    Else
        Do Until di = ""
            If UCase(di) = UCase(FileN) Then
                IsThere1 = True
                Exit Do
            End If
            di = Dir
        Loop
    End If
ByeBye:
    on error goto 0
End Function

InPath, Seperater
...
FileN, InFolder, Hidden, System, Directory
...
FullFileN, Hidden, System, Directory

Views 3611 Downloads 1324

VBA-Excel File System
ANmarAmdeen
810
Attachments
Revisions

v7.0

Needs