Excel VBA Verifica se la directory esiste errore

Question

Ho un foglio di calcolo che dopo aver fatto clic su un pulsante si duplicherà copiando/incollando tutto in una nuova cartella di lavoro e salvando il file con un nome che dipende da alcuni valori di variabile (prelevati dalle celle in il foglio di calcolo). Il mio obiettivo attuale è ottenere che salvi il foglio in cartelle diverse a seconda del nome del nome del client (valore della cella contenuto nella variabile), mentre questo funziona alla prima esecuzione, dopo ho ricevuto un errore.

Il codice controlla se la directory esiste e la crea in caso contrario. Questo funziona, ma dopo la creazione, in esecuzione una seconda volta genera l'errore:

Runtime Error 75 - path/file access error.

Il mio codice:

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 

Dovrete scusare la mia mancanza di conoscenze in questo settore, Sto ancora imparando. Ho la sensazione molto forte che abbia qualcosa a che fare con la logica di controllo della directory, come quando viene lanciato l'errore la linea MkDir è evidenziata.

Answer 1

per verificare l'esistenza di una directory utilizzando Dir, è necessario specificare vbDirectory come secondo argomento, come in qualcosa di simile:

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

Si noti che, con vbDirectory, Dir restituirà un non vuoto stringa se il percorso specificato esiste già come directory o come file (a condizione che il file non abbia nessuno degli attributi di sola lettura, nascosto o di sistema). È possibile utilizzare GetAttr per accertarsi che si tratti di una directory e non di un file.

Answer 2

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

Answer 3

per essere certi che una cartellaesiste (e non un file di ) Io uso questa funzione:

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

Funziona sia con \ alla fine e senza.

Answer 4

Utilizzare il metodo FolderExists dell'oggetto di script.

Public Function dirExists(s_directory As String) As Boolean 

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

End Function 

Answer 5

È possibile sostituire WB_parentfolder con qualcosa come "C: \". Per me WB_parentfolder sta acquisendo la posizione della cartella di lavoro corrente. file_des_folder è la nuova cartella che voglio. Questo attraversa e crea tutte le cartelle che ti servono.

 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

ho finito per usare:

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 

che è un mix di @ Brian e @ZygD risposte. dove penso che @Brian answer non sia abbastanza e non mi piace "On Error Resume Next" dalla risposta @ZygD