VCS_Dir.bas 1.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859
  1. Option Compare Database
  2. Option Private Module
  3. Option Explicit
  4. ' Path/Directory of the current database file.
  5. Public Function ProjectPath() As String
  6. ProjectPath = CurrentProject.Path
  7. If Right$(ProjectPath, 1) <> "\" Then ProjectPath = ProjectPath & "\"
  8. End Function
  9. ' Path/Directory for source files
  10. Public Function SourcePath() As String
  11. SourcePath = ProjectPath & CurrentProject.name & ".src\"
  12. End Function
  13. ' Create folder `Path`. Silently do nothing if it already exists.
  14. Public Sub MkDirIfNotExist(ByVal Path As String)
  15. On Error GoTo MkDirIfNotexist_noop
  16. MkDir Path
  17. MkDirIfNotexist_noop:
  18. On Error GoTo 0
  19. End Sub
  20. ' Delete a file if it exists.
  21. Public Sub DelIfExist(ByVal Path As String)
  22. On Error GoTo DelIfNotExist_Noop
  23. Kill Path
  24. DelIfNotExist_Noop:
  25. On Error GoTo 0
  26. End Sub
  27. ' Erase all *.`ext` files in `Path`.
  28. Public Sub ClearTextFilesFromDir(ByVal Path As String, ByVal Ext As String)
  29. Dim fso As Object
  30. Set fso = CreateObject("Scripting.FileSystemObject")
  31. If Not fso.FolderExists(Path) Then Exit Sub
  32. On Error GoTo ClearTextFilesFromDir_noop
  33. If dir$(Path & "*." & Ext) <> vbNullString Then
  34. fso.DeleteFile Path & "*." & Ext
  35. End If
  36. ClearTextFilesFromDir_noop:
  37. On Error GoTo 0
  38. End Sub
  39. Public Function DirExists(ByVal strPath As String) As Boolean
  40. On Error Resume Next
  41. DirExists = False
  42. DirExists = ((GetAttr(strPath) And vbDirectory) = vbDirectory)
  43. End Function
  44. Public Function FileExists(ByVal strPath As String) As Boolean
  45. On Error Resume Next
  46. FileExists = False
  47. FileExists = ((GetAttr(strPath) And vbDirectory) <> vbDirectory)
  48. End Function