Создать папку

Ответы на вопросы, чаще всего задаваемые в форумах VBStreets. Для тех, кому лень искать.
hCORe
VB - Экстремал
VB - Экстремал
Аватара пользователя
 
Сообщения: 2332
Зарегистрирован: 22.02.2003 (Сб) 15:21
Откуда: parent directory

Создать папку

Сообщение hCORe » 27.05.2006 (Сб) 12:47

Обычная функция MkDir "валится", если задан несуществующий путь. Функция MkFolder, наоборот, создает его полностью. Простейший код.

Код: Выделить всё
'MkFolder subroutine
'   Creates specified folder
'   Accepts any valid non-UNC path, even if none of its components
'   has yet been created
'   Could work with both slashes / and backslashes \
'   Doesn't return an error, except for the case you entered invalid path
'author: hCORe <entropia@fluda.net>
Public Sub MkFolder(sFolder As String)
On Error Resume Next
    If Len(sFolder) < 4 Then
        On Error GoTo 0
        Err.Raise 5, "MkFolder", "Invalid argument: folder path should be at least 4 characters long."
    End If
   
    ChDrive Left$(sFolder, 3)
    If Right$(sFolder, 1) = "\" Then sFolder = Mid$(sFolder, 1, Len(sFolder) - 1)
   
    'replace slashes to backslashes
    sFolder = ReplTxt(sFolder, "/", "\")
    Dim aSubs() As String
    'split string into an array
    aSubs = Split(sFolder, "\")
   
    Dim i As Long
    Dim sMake As String
   
    'walk through the path, skipping element 0 (drive)
    sMake = aSubs(0)
    For i = 1 To UBound(aSubs)
        sMake = sMake & "\" & aSubs(i)
        MkDir sMake
    Next
   
    'cleanup
    Erase aSubs()
    Err.Clear
End Sub

'ReplTxt Function
'   Wrapper for VBA.Replace
'author: hCORe <entropia@fluda.net>
Public Function ReplTxt(sWhere As String, sWhat As String, sReplace As String, Optional eCompare As VbCompareMethod = vbBinaryCompare) As String
On Error Resume Next
    Dim sTmp As String
    sTmp = sWhere
    sTmp = VBA.Replace(sTmp, sWhat, sReplace, , , eCompare)
    If sTmp = sWhat Then sTmp = sWhere
    ReplTxt = sTmp
End Function


Пример использования:
Код: Выделить всё
'create folder
MkFolder "C:\ABC/DEF/GHI/jkl/mno\pqr/stu/vwx\yz/my_folder"
'show it in Windows Explorer
Shell "explorer C:\ABC", vbNormalFocus


Этот код создаст папку C:\ABC\DEF\GHI\jkl\mno\pqr\stu\vwx\yz\my_folder и откроет ее в "Проводнике".
Моду создают модоки, а распространяют модозвоны.

Вернуться в Популярные вопросы

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 0

    TopList