web-dev-qa-db-fra.com

Excel VBA Check si le répertoire existe erreur

J'ai un tableur qui, en cliquant sur un bouton, se duplique en copiant/collant le tout dans un nouveau classeur et enregistre le fichier avec un nom dépendant de certaines valeurs variables (extraites des cellules de la feuille de calcul). Mon objectif actuel est de le faire enregistrer la feuille dans différents dossiers en fonction du nom du nom du client (valeur de la cellule conservée dans la variable), alors que cela fonctionne lors de la première exécution, une erreur se produit après.

Le code vérifie si le répertoire existe et le crée sinon. Cela fonctionne, mais après sa création, l'exécuter une seconde fois génère l'erreur suivante:

Runtime Error 75 - Erreur d'accès au chemin/fichier.

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, j'apprends encore. J'ai vraiment le sentiment que cela a quelque chose à voir avec la logique de vérification des répertoires, car lorsque l'erreur est générée, la ligne MkDir est en surbrillance.

excelvbafiledirectory
36
user1571463

Pour vérifier l'existence d'un répertoire à l'aide de Dir, vous devez spécifier vbDirectory comme deuxième argument, comme suit:

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

Notez qu'avec vbDirectory, Dir renverra une chaîne non vide si le chemin spécifié existe déjà sous la forme d'un répertoire ou sous la forme d'un fichier (à condition que le fichier ne soit pas t n’avoir aucun attribut en lecture seule, caché ou système). Vous pouvez utiliser GetAttr pour vous assurer que c'est un répertoire et non un fichier.

98
Brian Camire

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
22
ozmike

Pour être certain qu'un dossier existe (et non un fichier) j'utilise cette fonction:

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

Cela fonctionne les deux, avec \ à la fin et sans.

5
ZygD

J'ai fini par utiliser:

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

qui est un mélange de réponses @Brian et @ZygD. Je pense que la réponse de @ Brian ne suffit pas et n'aime pas le On Error Resume Next utilisé dans la réponse de @ ZygD

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