MkDir legt keine Verzeichnisse an
05.02.2007 08:53:35
Thomas
ich möchte Dateinamen automatisch erzeugen lassen und in verschiedene Verzeichnisse speichern, diese sollen angelegt werden, falls noch nicht vorhanden.
Variablen zum Dateinamen kommen aus Eingabe (C4, C7 & C10) sie werden auf a-c gespeichert.
In den Zellen Speicher_Pfad(A3-C3) gespeichert auf d-f stehen die Zielverzeichnisse.
Ist das Verzeichnis vorhanden klappt das auch ganz gut, aber seltsamerweise legt er die Verzeichnisse nicht an.
Hat jemand eine Idee, was ich falsch gemacht habe.
Gruß Tom
Private Sub Datei_speichern()
'Pfad = ActiveWorkbook.Path
Dim strFolder1, strFolder2, strFolder3 As String
Dim Nachname_Vorname, Datum, Diagnose
Dim a, b, c, d, e, f
With Worksheets("Eingabe")
a = .Cells(4, 3)
Nachname_Vorname = Split(a, ", ")
b = .Cells(7, 3)
Datum = Split(b, ".")
c = .Cells(10, 3)
Diagnose = Split(c, "-")
End With
With Worksheets("Speicher_Pfad")
d = .Cells(3, 1) 'Laufwerk (Zellinhalt z.B. C:)
e = .Cells(3, 2) 'Hauptverzeichnis
f = .Cells(3, 3) 'Unterverzeichnis
strFolder1 = d & "\" & e 'Hauptverzeichnis
strFolder2 = d & "\" & e & "\" & f 'Unterverzeichnis
strFolder3 = d & "\" & e & "\" & f & "\" & Diagnose(0) & "-" & Diagnose(1) 'Zielverzeichnis
End With
If Dir(strFolder3, vbDirectory) <> "" Then
GoTo speichern
Else
If MsgBox("Das Verzeichnis " & """" & strFolder3 & """" & " existiert nicht, " & _
vbLf & "neu anlegen? ", vbQuestion + vbYesNo) = vbNo Then Exit Sub
End If
If Dir(strFolder1, vbDirectory) = "" Then MkDir (strFolder1)
If Dir(strFolder2, vbDirectory) = "" Then MkDir (strFolder2)
MkDir (strFolder3)
GoTo speichern
speichern:
ActiveWorkbook.SaveAs strFolder3 & "\" & "Werkstatt" _
& "_" & Diagnose(0) & Diagnose(1) & "_" _
& Nachname_Vorname(0) & "_" & Nachname_Vorname(1) & "_" _
& Datum(0) & "_" & Datum(1) & "_" & Datum(2) & ".xls"
End Sub