| |
Три пути создания папки |
|
| |
Разместите на форме элемент CommandButton
'1 ВАРИАНТ
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateDirectory Lib "kernel32" Alias
"CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As
SECURITY_ATTRIBUTES) As Long
Public Sub CreateNewDirectory(NewDirectory As String)
Dim sDirTest As String
Dim SecAttrib As SECURITY_ATTRIBUTES
Dim bSuccess As Boolean
Dim sPath As String
Dim iCounter As Integer
Dim sTempDir As String
iFlag = 0
sPath = NewDirectory
If Right(sPath, Len(sPath)) <> "\" Then
sPath = sPath & "\"
End If
iCounter = 1
Do Until InStr(iCounter, sPath, "\") = 0
iCounter = InStr(iCounter, sPath, "\")
sTempDir = Left(sPath, iCounter)
sDirTest = Dir(sTempDir)
iCounter = iCounter + 1
'create directory
SecAttrib.lpSecurityDescriptor = &O0
SecAttrib.bInheritHandle = False
SecAttrib.nLength = Len(SecAttrib)
bSuccess = CreateDirectory(sTempDir, SecAttrib)
Loop
End Sub
Private Sub Form_Load()
Call CreateNewDirectory("c:\123\456\789\")
End Sub
'2 ВАРИАНТ
Private Declare Function MakeSureDirectoryPathExists Lib "IMAGEHLP.DLL" (ByVal
DirPath As String) As Long
Sub CreateFolder(ByVal DestPath As String)
If Right(DestPath, 1) <> "\" Then DestPath = DestPath & "\"
If MakeSureDirectoryPathExists(DestPath) = 0 Then
MsgBox "Ошибка в создании папки: " & DestPath
End If
End Sub
Public Function FileName(FilePath As String)
Dim strArray() As String
strArray = Split(FilePath, "\")
FileName = strArray(UBound(strArray))
End Function
Private Sub Form_Load()
CreateFolder ("c:\123\456\789")
End Sub
'3 ВАРИАНТ
Private Sub Command1_Click()
On Error GoTo errorfolder:
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CreateFolder "c:\new_folder"
errorfolder:
If Err = 58 Then MsgBox "File already exists"
Exit Sub
End Sub
|
|
| |
|
|
|
|