home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 7_2009-2012.ISO / data / zips / Video_Surv21911810202010.psc / CreateDir.bas < prev    next >
BASIC Source File  |  2007-11-13  |  2KB  |  54 lines
  1. Attribute VB_Name = "CreateDir"
  2. Option Explicit
  3.  
  4. Sub Create_Directory(ByVal sdirectory As String)
  5.  
  6. '---------------CREATE A DIRECTORY-----------------------
  7. 'This procedure creates the directory where the file(s)
  8. 'are to be installed. There is some error handling in
  9. 'it incase the directory already exists.
  10. '--------------------------------------------------
  11.  
  12. Dim strPath As String       'The directory which will be created...
  13. Dim intOffset As Integer    'Searches for a "\" so it can create the dirs...
  14. Dim intAnchor As Integer    'Equal to the above variable...
  15. Dim strOldPath As String    'Returns the CurDir to the old path(the dir
  16.                             'the setup file is in)...
  17.  
  18. On Error Resume Next        'Error handling...
  19.  
  20. strOldPath = CurDir$        'Find the current Directory...
  21. intAnchor = 0               'Reset intAnchor...
  22.  
  23. 'Searches for the "\" to create the dirs properly...
  24. intOffset = InStr(intAnchor + 1, sdirectory, "\")
  25. intAnchor = intOffset   'Equal to the above...
  26. Do
  27.     intOffset = InStr(intAnchor + 1, sdirectory, "\")
  28.     intAnchor = intOffset
  29.     
  30.     If intAnchor > 0 Then   'If there is 1 or more "\" then...
  31.         
  32.         'Create the directory using the text before the "\"...
  33.         strPath = Left$(sdirectory, intOffset - 1)
  34.         
  35.         ' Determine if this directory already exists...
  36.         Err = 0
  37.         ChDir strPath   'If it does, change to that directory...
  38.         
  39.         If Err Then     'If it doesn't exist...
  40.             
  41.             ' We must create this directory...
  42.             Err = 0
  43.             MkDir strPath   'Make the Directory...
  44.         End If
  45.     End If
  46. Loop Until intAnchor = 0    'Loop until all directories have been made
  47.                             'I.e C:\Prog\David\Cowan is 3 directories...
  48. Done:
  49.     ChDir strOldPath        'Change back to the the 'old' current directory...
  50. Err = 0                     'Reset the error number...
  51. End Sub
  52.  
  53.  
  54.