web-dev-qa-db-de.com

Excel VBA Überprüfen Sie, ob das Verzeichnis fehlerhaft ist

Ich habe eine Tabelle, die sich beim Klicken auf eine Schaltfläche selbst dupliziert, indem sie alles in eine neue Arbeitsmappe kopiert/einfügt und die Datei unter einem Namen speichert, der von einigen variablen Werten abhängt (entnommen aus Zellen in der Tabelle). Mein aktuelles Ziel ist es, das Blatt in Abhängigkeit vom Namen des Kunden (Zellenwert in Variable) in verschiedenen Ordnern zu speichern. Während dies beim ersten Durchlauf funktioniert, erhalte ich nachher eine Fehlermeldung.

Der Code prüft, ob das Verzeichnis existiert und erstellt es, wenn nicht. Dies funktioniert, aber nachdem es erstellt wurde, löst ein zweites Ausführen den Fehler aus:

Laufzeitfehler 75 - Pfad-/Dateizugriffsfehler.

Mein 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

Sie müssen meinen Mangel an Kenntnissen auf diesem Gebiet entschuldigen, ich lerne noch. Ich habe das starke Gefühl, dass es etwas mit der Verzeichnisprüflogik zu tun hat, da beim Auslösen des Fehlers die Zeile MkDir hervorgehoben wird.

excelvbafiledirectory
36
user1571463

Um die Existenz eines Verzeichnisses mit Dir zu überprüfen, müssen Sie vbDirectory als zweites Argument angeben, wie in etwa:

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

Beachten Sie, dass mit vbDirectoryDir eine nicht leere Zeichenfolge zurückgibt, wenn der angegebene Pfad bereits als Verzeichnis existiert oder als Datei (sofern die Datei dies nicht tut) keine schreibgeschützten, versteckten oder Systemattribute haben). Sie können GetAttr verwenden, um sicherzugehen, dass es sich um ein Verzeichnis und nicht um eine Datei handelt.

98
Brian Camire

Verwenden Sie die FolderExists-Methode des Skriptobjekts.

Public Function dirExists(s_directory As String) As Boolean

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

End Function
22
ozmike

Um sicherzugehen, dass ein Ordner existiert (und kein Datei), benutze ich diese Funktion:

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

Es funktioniert beides, mit \ am Ende und ohne.

5
ZygD

Ich habe folgendes benutzt:

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

das ist eine Mischung aus @Brian und @ZygD Antworten. Wo ich denke, dass die Antwort von @ Brian nicht ausreicht und das in der Antwort von @ ZygD verwendete On Error Resume Next Nicht gefällt

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