Tvorba adresářové struktury

Funkce:

Public Function DirExist(dPath As String) As Boolean

   ' Test existence sdresáře
   If Dir(dPath, vbDirectory) <> "" Then
      DirExist = True
   Else
      DirExist = False
   End If
End Function

Public Function DirCreateNested(dPath As String) As Boolean
    
   ' Tato funkce vytváří adresářovou strukturu
   ' např. c:\Dir1\Dir2\Dir3. Vrací úspěšnost.

   On Error GoTo ErrHandler
    
   Dim dNr As Integer, cNr As Integer

   cNr = 1
   If Right(dPath, 1) <> "\" Then dPath = dPath & "\"

   Do
      dNr = InStr(cNr, dPath, "\", vbTextCompare)
      If dNr >= cNr Then
         If DirExist(Left(dPath, dNr)) = False Then
            MkDir (Left(dPath, dNr))
         End If
         cNr = dNr + 1: If cNr >= Len(dPath) Then Exit Do
      End If
   Loop
    
   DirCreateNested = True
   Exit Function
    
ErrHandler:
   DirCreateNested = False
    
End Function

Pokud chcete otestovat, že adresář c:\dir1\dir2\dir3 existuje, použijte tento kód:

   Dim isTrue As Boolean
   isTrue = DirExist("c:\dir1\dir2\dir3")

Pokud adresářová struktura neexistuje, pak použijte::

   Call DirCreateNested("c:\dir1\dir2\dir3")

Jednoduché a efektivní.

 

Zpět

Autor: The Bozena