FixPath, IsThere, IsThere1

Set of 3 functions to deal with filesystem.
Gets current workbook path, searches for a file in certain folder.
3 of my most important functions since 2002
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", Optional URL_ifOneDrive = 0)
   ' 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" And URL_ifOneDrive = 0 Then
         Dim fso
         Set fso = CreateObject("Scripting.FileSystemObject")
         InPath = GetPapa(fso.GetAbsolutePathName(ThisWorkbook.Name))
      End If
   End If
   If Right(InPath, 1) <> Sepa Then InPath = InPath & Sepa
   FixPath = InPath
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, URL_ifOneDrive 
...
FileN, InFolder, Hidden, System, Directory
...
FullFileN, Hidden, System, Directory

Views 2659 Downloads 1050

VBA-Excel File System
ANmarAmdeen
755
Attachments
Revisions

v5.0

Needs