Excel VBA vérifier si le répertoire existe erreur
j'ai une feuille de calcul qui, en cliquant sur un bouton se dupliquera en copiant/collant tout sur un nouveau classeur et enregistrer le fichier avec un nom qui dépend de certaines valeurs variables (prises à partir des cellules sur la feuille de calcul). Mon objectif actuel est de l'obtenir pour sauvegarder 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 course, je reçois une erreur après.
Le code vérifie si le répertoire existe et crée si elle n'est pas. Cela fonctionne, mais après qu'il est créé, le lancer une deuxième fois jette l'erreur:
erreur D'exécution 75-chemin / erreur d'accès au 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:13 Recieved Schedules" & "" & client) = Empty Then
MkDir "C:13 Recieved Schedules" & "" & client
End If
SrceFile = "C:13 Recieved Schedulesschedule template.xlsx"
DestFile = "C:13 Recieved Schedules" & client & "" & client & " " & site & " " & screeningdate_text & ".xlsx"
FileCopy SrceFile, DestFile
Range("A1:I37").Select
Selection.Copy
Workbooks.Open Filename:= _
"C:13 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
veuillez excuser mon manque de connaissances dans ce domaine, je suis encore en apprentissage.
J'ai le sentiment très fort que cela a quelque chose à voir avec la logique de vérification des répertoires, comme quand l'erreur est lancée le MkDir la ligne est surlignée.
6 réponses
pour vérifier l'existence d'un répertoire en utilisant Dir, vous devez spécifier
If Dir("C:13 Recieved Schedules" & "\" & client, vbDirectory) = "" Then
Notez que, avec vbDirectory, Dir renvoie une chaîne non vide si le chemin spécifié existe déjà sous forme de répertoire ou dans un fichier (pourvu que le fichier n'ait aucun des attributs read-only, hidden, ou system). Vous pouvez utiliser GetAttr pour être sûr que c'est un répertoire et pas un fichier.
Utilisez la méthode FolderExists de l'objet scripting.
Public Function dirExists(s_directory As String) As Boolean
Set OFSO = CreateObject("Scripting.FileSystemObject")
dirExists = OFSO.FolderExists(s_directory)
End Function
If Len(Dir(ThisWorkbook.Path & "\YOUR_DIRECTORY", vbDirectory)) = 0 Then
MkDir ThisWorkbook.Path & "\YOUR_DIRECTORY"
End If
Pour être certain qu'un dossier existe (et pas un le 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
il fonctionne les deux, avec \ à la fin et sans.
j'ai utilisé:
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
qui est un mélange de réponses @Brian et @ ZygD. là où je pense que la réponse de @Brian n'est pas suffisante et n'aime pas le "On Error Resume Next" de la réponse de @ZygD
Vous pouvez remplacer WB_parentfolder par quelque chose comme "C:\". Pour moi, WB_parentfolder saisit l'emplacement du classeur actuel. file_des_folder est le nouveau dossier que je veux. Cela va à travers 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