'------------创建目录-------------------
'申明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
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
((("