VB6中简单文件与文件夹操作

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal DirPath As String) As Long

Public Function CreateFolders(ByVal FolderPath As String) As Boolean
If Not Right(FolderPath, 1) = "\" Then FolderPath = FolderPath & "\"    '参数必须以反斜杠 "\" 结尾，否则创建失败或者创建一个同名空文件
CreateFolders = MakeSureDirectoryPathExists(FolderPath)                 '如果未指明磁盘位置(例如相对路径)，将从编译后应用程序的工作路径创建。如果在 IDE 环境将在 %systemroot%\System32 文件夹内创建。32 位程序操作 64 位系统时则从 %systemroot%\SysWOW64 目录创建。
End Function

Public Function PathFileExist(ByVal PathFile As String) As Long '返回 0 表示不存在，返回 1 表示是文件，返回 -1 表示是文件夹，返回 2 表示是磁盘分区，返回 -2 表示不是合法文件路径或文件名
'vbAlias    64  指定的文件名是一个别名。只在 Macintosh(Mac OS) 中可用
On Error Resume Next
If Right(PathFile, 1) = "\" Then PathFile = Left(PathFile, Len(PathFile) - 1)
If Len(Dir(PathFile, vbReadOnly Or vbHidden Or vbSystem Or vbVolume Or vbArchive Or vbDirectory)) = 0 Then
PathFileExist = 0
Else
If (GetAttr(PathFile) And vbDirectory) = vbDirectory Then
If Len(PathFile) < 4 Then
PathFileExist = 2
Else
PathFileExist = -1
End If
Else
PathFileExist = 1
End If
End If
If Err.number = 52 Then PathFileExist = -2
End Function

'示例
Private Sub Command1_Click()
Dim TestDir As String
Dim IsExist As Long
TestDir = "F:\FolderTest\abc\"
IsExist = PathFileExist(TestDir)
If IsExist = 0 Then
If CreateFolders(TestDir) Then
MsgBox "准备使用的文件夹不存在，已创建。", vbInformation, "创建文件夹"
Else
MsgBox "创建文件夹失败。", vbCritical, "创建文件夹"
End If
ElseIf IsExist = 1 Then
If MsgBox("准备使用的文件夹被一个同名文件占用，是否删除此文件建立文件夹？", vbQuestion + vbYesNo, "创建文件夹") = vbYes Then
If Right(TestDir, 1) = "\" Then TestDir = Left(TestDir, Len(TestDir) - 1)
SetAttr TestDir, vbArchive
Kill TestDir
If CreateFolders(TestDir) Then
MsgBox "已删除同名文件并创建文件夹。", vbInformation, "创建文件夹"
End If
End If
ElseIf IsExist = 2 Then
MsgBox "准备使用的文件夹为磁盘分区，无法创建。", vbExclamation, "创建文件夹"
ElseIf IsExist = -1 Then
MsgBox "准备使用的文件夹已存在，无需再创建。", vbInformation, "创建文件夹"
Else    '-2
MsgBox "准备使用的文件夹名称非法，无法创建。", vbExclamation, "创建文件夹"
End If
End Sub