Excel VBA Sprawdź, czy istnieje błąd katalogu

Question

Mam arkusz kalkulacyjny, który po kliknięciu przycisku powieli się, kopiując/wklejając wszystko do nowego skoroszytu i zapisując plik o nazwie zależnej od niektórych wartości zmiennych (pobranych z komórek arkusz kalkulacyjny). Mój obecny cel to zmusić go do zapisania arkusza w różnych folderach w zależności od nazwy klienta (wartość komórki przechowywana w zmiennej), podczas gdy działa to przy pierwszym uruchomieniu, otrzymuję po nim błąd.

Kod sprawdza, czy katalog istnieje i tworzy go, jeśli nie. To działa, ale po jego utworzeniu, uruchomienie go po raz drugi wyrzuca błąd:

Runtime Error 75 - path/file access error.

Mój kod:

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 

Musisz wybaczyć mój brak wiedzy w tej dziedzinie, Jestem w trakcie nauki. Mam bardzo silne przeczucie, że ma coś wspólnego z logiką kontroli katalogów, ponieważ po zgłoszeniu błędu podświetlona jest linia MkDir.

Answer 1

Aby sprawdzić istnienie katalogu za pomocą Dir, trzeba określić vbDirectory jako drugi argument, jak na coś takiego:

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

zauważyć, że z vbDirectory, Dir zwróci niepusty ciąg znaków, jeśli określona ścieżka już istnieje jako katalog lub jako plik (pod warunkiem, że plik nie ma żadnych atrybutów tylko do odczytu, ukrytych lub systemowych). Możesz użyć GetAttr, aby upewnić się, że jest to katalog, a nie plik.

Answer 2

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

Answer 3

Aby mieć pewność, że folderu istnieje (a nie plik) używam tej funkcji:

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

Działa zarówno z \ na końcu i bez.

Answer 4

Użyj metody FolderExists obiektu skryptowego.

Public Function dirExists(s_directory As String) As Boolean 

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

End Function 

Answer 5

Możesz zastąpić WB_parentfolder czymś takim jak "C: \". Dla mnie WB_parentfolder chwyta lokalizację bieżącego skoroszytu. file_des_folder to nowy folder, który chcę. To przechodzi i tworzy tyle folderów, ile potrzebujesz.

 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 

Answer 6

skończyło się przy użyciu:

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

który jest mieszanką @Brian i @ZygD odpowiedzi. gdzie myślę, że odpowiedź @Brian nie wystarcza i nie podoba mi się "On Error Resume Next" z @ZygD answer