Set of 6 functions to deal with filesystem.
Gets current workbook path, searches for a file in certain folder.
6 of my most important functions since 2002
FixPath
FixPath_Not
IsThere
IsThere1
GetSon
GetPapa
Along with their versions ...
Edit 2022-02-05: Adding FixPath_Not() to make sure there is no slash at end
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
' =========== FixPath_Not
' Always remove '\' at end, making sure there is not at end
Function FixPath_Not(InPath)
' removes \ from end of path if found
Rett = InPath
If Right(InPath, 1) = "\" Then Rett = Left(InPath, Len(InPath) - 1)
FixPath_Not = Rett
End Function
' =========== 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
...
FileN, InFolder, Hidden, System, Directory
...
FullFileN, Hidden, System, Directory