42

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

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

运行时错误 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行被突出显示。

4

7 回答 7

111

要使用 来检查目录是否存在Dir，您需要指定vbDirectory第二个参数，例如：

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

请注意，如果指定的路径已经作为目录或文件存在（假设文件不具有任何只读、隐藏或系统属性）vbDirectory，则 withDir将返回非空字符串。您可以确定它是目录而不是文件。GetAttr

于 2013-03-18T16:35:24.133 回答
34

使用对象的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
于 2017-01-02T23:34:12.940 回答
7

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

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

它既适用\于最后，也适用于没有。

于 2015-11-18T05:53:47.033 回答
6

我最终使用：

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 的回答不够，不喜欢On Error Resume Next@ZygD 的回答中使用的

于 2017-08-25T11:48:34.730 回答
4 
If Len(Dir(ThisWorkbook.Path & "\YOUR_DIRECTORY", vbDirectory)) = 0 Then
   MkDir ThisWorkbook.Path & "\YOUR_DIRECTORY"
End If
于 2014-02-19T17:31:18.767 回答
3

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

Public Function IsDir(s) As Boolean
    IsDir = CreateObject("Scripting.FileSystemObject").FolderExists(s)
End Function
于 2020-04-03T03:23:37.270 回答
-1

您可以将 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
于 2017-08-24T22:08:18.070 回答