Excel VBA 检查目录是否存在错误

Excel VBA Check if directory exists error

提问by user1571463

I have a spreadsheet that upon clicking a button will duplicate itself by copying/pasting everything to a new workbook and save the file with a name that is dependent upon some variable values (taken from cells on the spreadsheet). My current goal is to get it to save the sheet in different folders depending on the name of client name (cell value held in variable), while this works on the first run, I get an error after.

我有一个电子表格，单击按钮后，它会通过将所有内容复制/粘贴到新工作簿来复制自身，并使用依赖于某些变量值（取自电子表格上的单元格）的名称保存文件。我目前的目标是让它根据客户端名称的名称（保存在变量中的单元格值）将工作表保存在不同的文件夹中，虽然这在第一次运行时有效，但之后出现错误。

The code checks if the directory exists and creates it if not. This works, but after it is created, running it a second time throws the error:

代码检查目录是否存在，如果不存在则创建它。这有效，但在创建后，第二次运行它会引发错误：

Runtime Error 75 - path/file access error.

运行时错误 75 - 路径/文件访问错误。

My code:

我的代码：

Sub Pastefile()

Dim client As String
Dim site As String
Dim screeningdate As Date
screeningdate = Range("b7").Value
Dim screeningdate_text As String
screeningdate_text = Format$(screeningdate, "yyyy\-mm\-dd")
client = Range("B3").Value
site = Range("B23").Value

Dim SrceFile
Dim DestFile

If Dir("C:13 Recieved Schedules" & "\" & client) = Empty Then
    MkDir "C:13 Recieved Schedules" & "\" & client
End If

SrceFile = "C:13 Recieved Schedules\schedule template.xlsx"
DestFile = "C:13 Recieved Schedules\" & client & "\" & client & " " & site & " " & screeningdate_text & ".xlsx"

FileCopy SrceFile, DestFile

Range("A1:I37").Select
Selection.Copy
Workbooks.Open Filename:= _
    "C:13 Recieved Schedules\" & client & "\" & client & " " & site & " " & screeningdate_text & ".xlsx", UpdateLinks:= _
    0
Range("A1:I37").PasteSpecial Paste:=xlPasteValues
Range("C6").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
ActiveWindow.Close

End Sub

You'll have to excuse my lack of knowledge in this area, I am still learning. I have a very strong feeling it has something to do with the directory checking logic, as when the error is thrown the MkDirline is highlighted.

你必须原谅我在这方面缺乏知识，我还在学习。我有一种非常强烈的感觉，它与目录检查逻辑有关，因为当抛出错误时，该MkDir行会突出显示。

回答by Brian Camire

To check for the existence of a directory using Dir, you need to specify vbDirectoryas the second argument, as in something like:

要使用 来检查目录是否存在Dir，您需要将其指定vbDirectory为第二个参数，如下所示：

If Dir("C:13 Recieved Schedules" & "\" & client, vbDirectory) = "" Then

Note that, with vbDirectory, Dirwill return a non-empty string if the specified path already exists as a directory or as a file(provided the file doesn't have any of the read-only, hidden, or system attributes). You could use GetAttrto be certain it's a directory and not a file.

需要注意的是，有vbDirectory，Dir就返回一个非空字符串，如果指定的路径已经存在的目录或文件（提供的文件不具有任何的只读，隐藏，或系统属性）。您GetAttr可以确定它是一个目录而不是一个文件。

回答by ozmike

Use the FolderExistsmethod of the Scriptingobject.

使用对象的FolderExists方法Scripting。

Public Function dirExists(s_directory As String) As Boolean
    Dim oFSO As Object
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    dirExists = oFSO.FolderExists(s_directory)
End Function

回答by ZygD

To be certain that a folderexists (and not a file) I use this function:

为了确定一个文件夹存在（而不是一个文件），我使用这个函数：

Public Function FolderExists(strFolderPath As String) As Boolean
    On Error Resume Next
    FolderExists = ((GetAttr(strFolderPath) And vbDirectory) = vbDirectory)
    On Error GoTo 0
End Function

It works both, with \at the end and without.

它同时工作，有\结束和没有。

回答by EGOBLIN

If Len(Dir(ThisWorkbook.Path & "\YOUR_DIRECTORY", vbDirectory)) = 0 Then
   MkDir ThisWorkbook.Path & "\YOUR_DIRECTORY"
End If

回答by TGN12

I ended up using:

我最终使用了：

Function DirectoryExists(Directory As String) As Boolean
    DirectoryExists = False
    If Len(Dir(Directory, vbDirectory)) > 0 Then
        If (GetAttr(Directory) And vbDirectory) = vbDirectory Then
            DirectoryExists = True
        End If
    End If
End Function

which is a mix of @Brian and @ZygD answers. Where I think @Brian's answer is not enough and don't like the On Error Resume Nextused in @ZygD's answer

这是@Brian 和@ZygD 答案的混合体。我认为On Error Resume Next@Brian 的回答不够并且不喜欢@ZygD 的回答中使用的

回答by Excel Hero

This is the cleanest way... BY FAR:

这是最干净的方式......到目前为止：

Public Function IsDir(s)
    IsDir = CreateObject("Scripting.FileSystemObject").FolderExists(s)
End Function

回答by Alex Johnson

You can replace WB_parentfolder with something like "C:\". For me WB_parentfolder is grabbing the location of the current workbook. file_des_folder is the new folder i want. This goes through and creates as many folders as you need.

您可以将 WB_parentfolder 替换为“C:\”之类的内容。对我来说 WB_parentfolder 正在抓取当前工作簿的位置。file_des_folder 是我想要的新文件夹。这会根据需要创建任意数量的文件夹。

        folder1 = Left(file_des_folder, InStr(Len(WB_parentfolder) + 1, file_loc, "\"))
        Do While folder1 <> file_des_folder
            folder1 = Left(file_des_folder, InStr(Len(folder1) + 1, file_loc, "\"))
            If Dir(file_des_folder, vbDirectory) = "" Then      'create folder if there is not one
                MkDir folder1
            End If
        Loop