Как создать папку

[D[u]fa]

MkDir “C:\Папка”

[SCINER]

Данная функция создает вложенные папки:

Option Explicit
Private Const INVALID_FILE_ATTRIBUTES As Long = -1
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As Any) As Long
Private Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
 
' Данная функция создает вложенные папки
' Она работает так MkDir_SS("C:\eto\papka\4etvertogo\urovnya")
Sub MkDir_SS(ByVal p$)
    'On Error Resume Next
    Dim tmp$, Tp$()
    tmp = vbNullString
    p = RCP(VBA.Trim$(p))
    Tp = Split(p, "\")
    Dim i As Long
    tmp = Tp(0) & "\"
    For i = 1 To UBound(Tp) - 1
        tmp = tmp & Tp(i) & "\"
        If Not FolderExists(tmp) Then
            Call CreateDirectory(tmp, ByVal 0&)
            If Err.LastDllError <> 0 Then
                Err.Raise 1, , "Can't created folder."
            End If
        End If
    Next
End Sub
 
Public Function FolderExists(ByVal strFolderName As String) As Boolean
    FolderExists = GetFileAttributes(strFolderName) <> INVALID_FILE_ATTRIBUTES
End Function
 
' Всегда возвращает строку со слешем на конце.
Public Function RCP(ByVal path As String) As String
    RCP = path & IIf(VBA.Right$(path, 1) = "\", vbNullString, "\")
End Function

Сообщение отредактировано: SCINER - 07.02.10, 10:09