' СОРС ЗА ФОРМАТА

'При кликане на бутона СЪЗДАЙ ДИРЕКТОРИЯ

Private Sub Command1_Click()

KratkoIme = InputBox("Въведете име за директорията, която искате да създадете", "Пример за създаване на директория") 'Въвеждаме краткото име на директорията

If KratkoIme <> "" Then ' Ако въведеното име не празен стринг

FullName = BrowseForFolder & KratkoIme ' Създаваме пълното име, чрез отваряне на диалогова форма за избор на мястото на новата директория

On Error GoTo dolu ' Манипулатор на грешка, възможно е вече да има директория с такова име

MkDir FullName ' РЕАЛНО СЪЗДАВАНЕ НА НОВАТА ДИРЕКТОРИЯ

MsgBox "Създадена е директория " & FullName, vbInformation, "" ' Съобщение за успешна операция

End If

Exit Sub

dolu: MsgBox "Директория " & FullName & " вече съществува", vbInformation, "Отказана операция!" ' ' Съобщение за отказана операция

End Sub

' При кликане на бутона ИЗТРИЙ ДИРЕКТОРИЯ

Private Sub Command2_Click()

FullNameDel = BrowseForFolder ' Чрез диалоговата форма от модула избираме директорията за изтриване

FullNameDel = Left(FullNameDel, Len(FullNameDel) - 1) ' Махаме излишната последна наклонена черта

Set fso = CreateObject("Scripting.FileSystemObject") ' Създаваме скриптов обект за манипулация на системни обекти

If Len(FullNameDel) > 0 Then

f1 = fso.FolderExists(FullNameDel) ' Проверка за съществуване на посочената директория - връща TRUE илиFALSE

If f1 = False Then ' Ако директорията не съществува

MsgBox "Няма такава директория!", , "" ' Показваме съобщение

Else ' Ако директорията съществува

On Error GoTo dolu: ' Манипулатор на грешка

fso.DeleteFolder (FullNameDel) ' РЕАЛНО ИЗТРИВАНЕ НА ЦЯЛАТА ДИРЕКТОРИЯ СЪС ВСИЧКИ ПАПКИ,ПОДПАПКИ И ФАЙЛОВЕ

MsgBox "Директорията е изтрита!", , "" ' Съобщение за успешна операция

End If

End If

Exit Sub

dolu:

MsgBox "Грешка - възможно е да има отворен или стартиран файл!", , "" ' Съобщение при неуспешна операция

End Sub

' СОРС ЗА МОДУЛА IzborDir

Private Type BrowseInfo

hWndOwner As Long

pIDLRoot As Long

pszDisplayName As Long

lpszTitle As String

ulFlags As Long

lpfnCallback As Long

lParam As Long

iImage As Long

End Type

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long)

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long

Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long

Private Declare Function GetActiveWindow Lib "user32" () As Long

' Функция за избор на директория

Public Function BrowseForFolder(Optional sCaption As String = "Select a folder", Optional sDefault As String) As String

Const BIF_RETURNONLYFSDIRS = 1

Const MAX_PATH = 260

Dim lPos As Integer, lpIDList As Long, lResult As Long

Dim sPath As String, tBrowse As BrowseInfo

With tBrowse

.hWndOwner = GetActiveWindow

.lpszTitle = sCaption

.ulFlags = BIF_RETURNONLYFSDIRS '

End With

lpIDList = SHBrowseForFolder(tBrowse)

If lpIDList Then

sPath = String$(MAX_PATH, 0)

SHGetPathFromIDList lpIDList, sPath

CoTaskMemFree lpIDList

lPos = InStr(sPath, vbNullChar)

If lPos Then

BrowseForFolder = Left$(sPath, lPos - 1)

If Right$(BrowseForFolder, 1) <> "\" Then

BrowseForFolder = BrowseForFolder & "\"

End If

End If

Else

BrowseForFolder = sDefault

End If

End Function