Excel VBA 디렉토리가 있는지 확인 오류

Excel VBA 디렉토리가 있는지 확인 오류

버튼을 클릭하면 모든 것을 새 워크북에 복사/붙여넣고 파일을 일부 변수 값(스프레드시트의 셀에서 가져온 이름)으로 저장할 수 있는 스프레드시트가 있습니다.현재의 목표는 클라이언트명(셀값 가변 보유)에 따라 시트를 다른 폴더에 저장하는 것입니다.첫 번째 실행에서는 에러가 발생합니다.

코드는 디렉토리가 존재하는지 여부를 확인하고 존재하지 않는 경우 디렉토리를 만듭니다.이것은 동작합니다만, 작성한 후에, 재차 실행하면, 다음의 에러가 발생합니다.

런타임 오류 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선이 강조 표시됩니다.

다음을 사용하여 디렉토리의 존재를 확인하려면Dir, 를 지정해야 합니다.vbDirectory다음과 같은 두 번째 인수로 사용합니다.

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

주의:vbDirectory,Dir지정된 경로가 디렉토리 또는 파일로 이미 존재하는 경우(파일에 읽기 전용, 숨김 또는 시스템 속성이 없는 경우)는 빈 문자열이 아닌 문자열을 반환합니다.사용할 수 있습니다.GetAttr파일이 아닌 디렉토리인지 확인합니다.

를 사용합니다.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

파일이 아닌 폴더가 존재하는지 확인하려면 다음 기능을 사용합니다.

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

양쪽 모두 기능합니다.\끝과 끝없이.

사용 결과:

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의 답변에 사용

이게 가장 깨끗한 방법이야지금까지:

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

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

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

언급URL : https://stackoverflow.com/questions/15480389/excel-vba-check-if-directory-exists-error