VB 创建文件夹

新建

if   dir( "c:\test ",vbDirectory)= " "   then   mkdir   "c:\test "

或用fso

2007-06-10

用vb创建文件夹并检查其是否已存在

版权声明：转载时请以超链接形式标明文章原始出处和作者信息及本声明
http://yuna.blogbus.com/logs/5766796.html

 方法一：

Public Function CheckDir(ByVal DirName As String) As Boolean
    Dim ret     As Integer
    ret = SHFileExists(DirName)
    If ret = 0 Then
       CheckDir = False

    Else
       CheckDir = True
    End If
  End Function

    If Dir("C:\Program Files\VIEWGOOD", vbDirectory) <> "" Then  'MsgBox "存在"

如果一个文件夹下没有文件（不管有没有子文件夹）则 dir("一个文件夹")就返回空

所以不能通过 dir("一个文件夹")来判断一个文件夹是否存在。

只能调用api函数

Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long

PathFileExists("一个文件或文件夹") 如果存在 返回1 不存在返回0 

方法二：

1   新建一个工程在窗口上添加一个TextBox、一个CommandButton、一个Label

设置textbox的text属性为c:\test

设置label的caption属性为空

 

2   单击 工程(P)>>引用(N)

 

 

Microsoft   Scripting   Control   1.0   
  Microsoft   Scripting   Runtime  

勾选以上两个选项，单击 确定 完成引用

3 双击Command1在Private Sub Command1_Click()

Dim fso As New FileSystemObject

和

End Sub

之间添加如下内容!

If fso.FolderExists(Text1.Text) Then

       MsgBox "要创建的文件已存在!", vbOKOnly, "警告"

Else

    fso.CreateFolder (Text1.Text)

    Label1.Caption = Text1.Text + "创建成功!"

End If

 

至此，新建文件夹功能已经实现!

 

下边我们来实现判断文件夹是否为空!

 

1 在窗口中再添加一个CommandButton，双击CommandButton在：

Private Sub Command2_Click()
和
End Sub

之间写入如下代码

    If Not fso.FolderExists(Text1.Text) Then
        MsgBox "要判断的文件不存在!", vbOKOnly, "警告"
    Else
        Dim FolderSize As Long
        FolderCount = fso.GetFolder(Text1.Text).SubFolders.Count
        Debug.Print FolderCount
        Label1.Caption = Str(FolderCount)
        
        If FolderCount Then
            MsgBox "此文件夹共有:" + Str(FolderCount) + "个文件\文件夹!", vbOKOnly, "警告"
        Else
            MsgBox "此文件夹为空!", vbOKOnly, "警告"
        End If
    End If

------------------------------------------测试用--------------------------

Private Function creat_folder()
ChDrive "D"
If Dir("D:\SPC-TO-WINDING", vbDirectory) <> "" Then
Else
MkDir "D:\SPC-TO-WINDING"
End If


ChDir "D:\SPC-TO-WINDING"
If Dir(M_NO, vbDirectory) <> "" Then
Else
MkDir M_NO
End If

ChDir "D:\SPC-TO-WINDING\" + M_NO
If Dir(P_NAME, vbDirectory) <> "" Then
Else
MkDir P_NAME
End If

ChDir "D:\SPC-TO-WINDING\" + M_NO + "\" + P_NAME
If Dir(P_NO, vbDirectory) <> "" Then
Else
MkDir P_NO
End If

ChDir "D:\SPC-TO-WINDING\" + M_NO + "\" + P_NAME + "\" + P_NO
If Dir(CStr(Date) + ".txt", vbDirectory) <> "" Then
Else
Call creat_txt(M_NO, P_NAME, P_NO)
End If
End Function

Private Function creat_txt(M_NO As String, P_NAME As String, P_NO As String)
Dim FILENAM As String
Dim msg As String
FILENAM = "D:\SPC-TO-WINDING\" + M_NO + "\" + P_NAME + "\" + P_NO + "\" & CStr(Format$(Now, "yyyy-mm-dd")) & ".txt"
'Kill FILENAM
If Dir(FILENAM) = "" Then
    Open FILENAM For Output As #1
Else
    Open FILENAM For Append As #1
End If

msg = "#;#;#;#;1;2;3"
Print #1, msg
msg = "MAX;#;#;#;100;55;70"
Print #1, msg
msg = "MIN;#;#;#;0;33.3;21.3"
Print #1, msg

Close #1
MsgBox "OK"
End Function