检查excel 2010 vba中是否存在目录

Question

我让用户输入一些MyBarcode and MyScan将用于创建目录的信息.如果该目录存在,我想显示一条消息,指示该目录并返回用户可以输入数据的步骤.它vba位于下方并且似乎起作用,除了目录检查,我需要一些帮助.我希望这是一个好的开始.谢谢 :).

Private Sub CommandButton3_Click()

Dim MyBarCode   As String      ' Enter Barcode
Dim MyScan      As String      ' Enter ScanDate
Dim MyDirectory As String

MyBarCode = Application.InputBox("Please enter the last 5 digits of the barcode", "Bar Code", Type:=2)

If MyBarCode = "False" Then Exit Sub   'user canceled
Do
    MyScan = Application.InputBox("Please enter scan date", "Scan Date", Date - 1, Type:=2)
    If MyScan = "False" Then Exit Sub   'user canceled
    If IsDate(MyScan) Then Exit Do
    MsgBox "Please enter a valid date format. ", vbExclamation, "Invalid Date Entry"
Loop

'Create nexus directory and folder check
MyDirectory = "N:\1_DATA\MicroArray\NexusData\" & "2571683" & MyBarCode & "_" & Format(CDate(MyScan), "m-d-yyyy") & "\"
If MyDirectory("MyDirectory") Then
    MsgBox "Folder exists! Please try again", Goto MyBarcode

Else
If Dir(MyDirectory, vbDirectory) = "" Then MkDir MyDirectory

Answer 1

使用Dir和GetAttr函数检查目录是否存在如下:

Function DirectoryExists(Directory As String) As Boolean
    DirectoryExists = False
    If Not Dir(Directory, vbDirectory) = "" Then
        If GetAttr(Directory) = vbDirectory Then
            DirectoryExists = True
        End If
    End If
End Function

Sub TestDirectoryExists()
    Dim Directory As String
    Directory = "c:\src"                    ' is a valid directory
    Debug.Print DirectoryExists(Directory)  ' shows True
    Directory = "c:\src1"                   ' is not a valid directory
    Debug.Print DirectoryExists(Directory)  ' shows False
    Directory = "x:\src"                    ' is not a valid drive
    Debug.Print DirectoryExists(Directory)  ' shows False
    Directory = "c:\test.txt"               ' is a file
    Debug.Print DirectoryExists(Directory)  ' shows False
End Sub

当我们将Dir与vbDirectory属性一起使用时,除了没有特殊属性的文件外,我们还在查找文件夹.为了确认我们确实在寻找文件夹,我们使用 GetAttr并检查该路径确实是一个文件夹.

您可以在按钮单击事件中随意使用此功能.