'以下代码可以建立多级文件夹:
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
'创建指定的目录(可以是多级目录)
Private Function CreateDirectory(ByVal sDirectory As String) As Boolean
'创建指定的目录(可以是多级目录),sDirectory:要创建的文件夹
On Error GoTo ErrHandle
Dim lngResult As Long
sDirectory = checkpath(sDirectory)
lngResult = MakeSureDirectoryPathExists(sDirectory)
CreateDirectory = IIf(lngResult = 0, False, True)
ErrHandle:
If Err <> 0 Then
CreateDirectory = False
End If
End Function
Private Function checkpath(ByVal sPath As String) As String
If Right$(sPath, 1) = "\" Then
checkpath = sPath
Else
checkpath = sPath & "\"
End If
End Function
Private Sub Command1_Click()
If Dir(App.Path & "\123\456") = "" Then CreateDirectory App.Path & "\123\456" '如果文件夹不存在,就创建
End Sub
Option Explicit
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
'创建指定的目录(可以是多级目录)
Private Function CreateDirectory(ByVal sDirectory As String) As Boolean
'创建指定的目录(可以是多级目录),sDirectory:要创建的文件夹
On Error GoTo ErrHandle
Dim lngResult As Long
sDirectory = checkpath(sDirectory)
lngResult = MakeSureDirectoryPathExists(sDirectory)
CreateDirectory = IIf(lngResult = 0, False, True)
ErrHandle:
If Err <> 0 Then
CreateDirectory = False
End If
End Function
Private Function checkpath(ByVal sPath As String) As String
If Right$(sPath, 1) = "\" Then
checkpath = sPath
Else
checkpath = sPath & "\"
End If
End Function
Private Sub Command1_Click()
If Dir(App.Path & "\123\456") = "" Then CreateDirectory App.Path & "\123\456" '如果文件夹不存在,就创建
End Sub