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

你可能感兴趣的:(VB6)