Excel VBA Vérifiez si le répertoire existe erreur

Question

J'ai une feuille de calcul qui en cliquant sur un bouton va se dupliquer en copiant/collant tout à un nouveau classeur et enregistrer le fichier avec un nom qui dépend de certaines valeurs variables (prises de cellules sur la feuille de calcul). Mon objectif actuel est de l'obtenir pour enregistrer la feuille dans différents dossiers en fonction du nom du client (valeur de la cellule détenue dans la variable), alors que cela fonctionne sur la première exécution, j'obtiens une erreur après.

Le code vérifie si le répertoire existe et le crée sinon. Cela fonctionne, mais après sa création, il en cours d'exécution d'une deuxième fois jette l'erreur:

Runtime Error 75 - path/file access error.

Mon code:

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 

Vous devrez excuser mon manque de connaissances dans ce domaine, Je suis toujours en train d'apprendre. J'ai le sentiment très fort que cela a quelque chose à voir avec la logique de vérification du répertoire, car lorsque l'erreur est levée, la ligne MkDir est en surbrillance.

Answer 1

Pour vérifier l'existence d'un répertoire à l'aide Dir, vous devez spécifier vbDirectory comme second argument, comme dans quelque chose comme:

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

Notez que, avec vbDirectory, Dir retournera un non-vide chaîne si le chemin spécifié existe déjà en tant que répertoire ou en tant que fichier (à condition que le fichier ne possède aucun attribut en lecture seule, caché ou système). Vous pouvez utiliser GetAttr pour être certain que c'est un répertoire et non un fichier.

Answer 2

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

Answer 3

Pour être certain qu'un dossier existe-je utiliser cette fonction (et non un fichier):

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

Il fonctionne à la fois, avec \ à la fin et sans.

Answer 4

Utilisez la méthode FolderExists de l'objet de script.

Public Function dirExists(s_directory As String) As Boolean 

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

End Function 

Answer 5

Vous pouvez remplacer WB_parentfolder par quelque chose comme "C: \". Pour moi, WB_parentfolder saisit l'emplacement du classeur en cours. file_des_folder est le nouveau dossier que je veux. Cela passe par et crée autant de dossiers que vous avez besoin.

 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

Je fini par utiliser:

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 

Ce qui est un mélange de réponses et @ZygD @ Brian. où je pense que @Brian réponse n'est pas assez et n'aime pas le "Sur Erreur Resume Suivant" de @ZygD réponse