Question

我有一个电子表格，单击一个按钮就可以通过将所有内容复制/粘贴到新工作簿来复制自己，并使用一个名称来保存文件，该名称取决于某些变量值（取自电子表格中的单元格）。我目前的目标是让它根据客户名称（变量中保存的单元格值）将表单保存在不同的文件夹中，而这在第一次运行时起作用，我之后收到错误。

代码检查目录是否存在，如果不存在则创建它。这可行，但在创建后，再次运行它会抛出错误：

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

我的代码：

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:\2013 Recieved Schedules" & "\" & client) = Empty Then
    MkDir "C:\2013 Recieved Schedules" & "\" & client
End If

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

FileCopy SrceFile, DestFile

Range("A1:I37").Select
Selection.Copy
Workbooks.Open Filename:= _
    "C:\2013 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

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

Answer 1

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

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

请注意，对于vbDirectory，如果指定的路径已作为目录或作为文件存在，则Dir将返回非空字符串（前提是文件没有＆＃39; t具有任何只读，隐藏或系统属性）。您可以使用GetAttr来确定它是目录而不是文件。

Answer 2

使用脚本对象的FolderExists方法。

Public Function dirExists(s_directory As String) As Boolean

Set OFSO = CreateObject("Scripting.FileSystemObject")
dirExists = OFSO.FolderExists(s_directory)

End Function

Answer 3

要确定文件夹存在（而不是文件），我使用此功能：

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

两者都有效，最后\没有。

Answer 4

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

Answer 5

我最终使用了：

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

这是@Brian和@ZygD答案的混合。在哪里我认为@Brian的回答是不够的，不喜欢@ ZygD回答中使用的On Error Resume Next

Answer 6

这是最干净的方法。。。FAR：

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

Answer 7

您可以使用＆＃34; C：\＆＃34;等替换WB_parentfolder。对我来说，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

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

7 个答案: