赠送几个ACCESS源码 （多种方法 创建 多级目录）

admin

赠送 几个源码 （多种方法 创建 多级目录）
并祝大家劳动节快乐：五一劳动节到，请遵守四项基本原则：将财神看守到底，将幸福紧握到底，将好运怀抱到底、将爱情进行到底！请严格遵守，直至革命胜利！

方法一

'------------创建目录-------------------
'申明API函数
Option Explicit
Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

'用法Call CreateDir("C:\test\test1\test2\")
Public Function CreateDir(NewDirectory As String) 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
    Dim iFlag As Integer
    iFlag = 0
    sPath = NewDirectory

    If Mid(sPath, Len(sPath) - 1) <> "\" Then
        sPath = sPath & "\"
    End If

    iCounter = 1
    Do Until InStr(iCounter, sPath, "\") = 0
        iCounter = InStr(iCounter, sPath, "\")
        sTempDir = Mid(sPath, 1, iCounter)
        sDirTest = Dir(sTempDir)
        iCounter = iCounter + 1

        SecAttrib.lpSecurityDescriptor = &O0
        SecAttrib.bInheritHandle = False
        SecAttrib.nLength = Len(SecAttrib)
        bSuccess = CreateDirectory(sTempDir, SecAttrib)
    Loop
    CreateDir = NewDirectory
End Function

方法二
Sub CreateDir(strPath As String) ' 这个创建目录更简单
    On Error Resume Next
    Dim ArrFolders As Variant
    ArrFolders = Split(strPath, "\")
    Dim i As Long
    Dim CurPath As String: CurPath = ArrFolders(0)
    MkDir CurPath


    For i = 1 To UBound(ArrFolders)
        CurPath = CurPath & "\" & ArrFolders(i)
        Debug.Print CurPath
        MkDir CurPath
    Next i
    On Error GoTo 0


    If Len(Dir(strPath, vbDirectory)) = 0 Then
        Err.Raise vbObjectError, , "Can't create dir" & vbCrLf & strPath & vbCrLf & ((("
    End If
End Sub



方法三

Private Function IfExist(Path As String) As Boolean
Dim Temp As String
    Temp = CurDir '
    On Error GoTo endi '
    '
    ChDir Path '
    IfExist = True '
    ChDir Temp ' Checks To see If the specified path exists,
    Exit Function ' and returns it as a Boolean (true or false)
    '
endi:     '
    IfExist = False '
    ChDir Temp '
End Function

Private Function slashval(Path As String) As String


    If right(Path, 1) = "\" Then
        slashval = ""
    Else
        slashval = "\"
    End If
End Function

Public Function CreatePath(Path As String) As Boolean
    CreatePath = False
    On Error GoTo endi
    Dim Section() As String
    Dim Dump As String
    Dim TempInt As Integer
    Section = Split(Path, "\")


    Do While Len(Section(TempInt)) > 0
        Dump = Dump & Section(TempInt) & slashval(Section(TempInt))


        If IfExist(Dump) = False Then
            MkDir Dump
        End If
        TempInt = TempInt + 1


        DoEvents
        Loop
        CreatePath = True
endi:
    End Function

风中漫步

祝大家节日快乐

Grant

上联：该吃吃 该喝喝 遇事别往心里搁；
下联：泡泡澡 看著表 舒服一秒是一秒；
横批：五一节快乐

yanwei82123300

坚决拥护支持

fine88888888

坚决拥护党的“五一”：我先开始：  一毛钱也不能花在自己身上。 一句不满的话也别这天说....

海婷

五一节快乐

ysh5858

祝大家节日快乐 !{:soso_e177:}

godsscourge

没整明白，学习中中

chengduld

谢谢

qingwen3003

城市，让生活更美好城市，让生活更美好城市，让生活更美好城市，让生活更美好