新建

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 "要判断的文件不存在!","警告"
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) + "个文件\文件夹!","警告"
Else
MsgBox "此文件夹为空!","警告"
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