Office: (Office 2010) Prüfen ob Ordner vorhanden, dann abspeichern

Hi,

ich habe eine Tabellenvorlage in der man die Prüflingsdaten eingibt.
B2 = Größe
B5 = Prüflingsnummer (soll dann als Ordner angelegt werden)

Ich habe ein Steuerelement "Speichern unter" angelegt, bei klick wird das Verzeichniss C:\Temp vorgeschlagen. Dann muss man noch den Unterordner mit der Nummer (B5) erstellen und Speichern drücken.

PHP:

         Sub Speichern_unter()

Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant

Verzeichnis = "C:\temp\" 'Verzeichnis-Vorschlag
Datei = Format(Date, "yymmdd_") & Range("B2") & "_Nummer._" & Range("B5") & ".xlsm"  'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt

End Sub



Function SpeichernUnter(VorgabeName As String) As Variant

SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsm),*.xls*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")

End Function


:)

 

Hi,

mit
If Dir("dein_Pfad" & "\" & dein Zellname) ="" then
mkdir "dein_Pfad" & "\" & dein Zellname
end if

 

Hi,

habe das jetzt mal so:

PHP:

         Sub Speichern_unter()

Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant
If Dir("C:\Temp" & "\" & "B5") = "" Then
MkDir "C:Temp" & "" & "B5"
End If
Verzeichnis = "C:Temp" 'Verzeichnis-Vorschlag
Datei = Format(Date, "yymmdd_") & Range("B2") & "_Nummer._" & Range("B5") & ".xlsm"  'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt

End Sub



Function SpeichernUnter(VorgabeName As String) As Variant

SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsm),*.xls*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")

End Function


 

Hallo,

warum lässt du einmal die Backslash weg?
Und du musst die Zelle ansprechen, dein Code schreibt nur B5
Code:

VG

 

Hallo zusammen,

als rudimentären Code habe ich mal folgende Function zusammengebastelt, inklusive Testaufruf:
Code:

Damit lassen sich auch Verzeichnisse prüfen / anlegen, wenn mehr als 1 Ordner des Pfades fehlt.

Grüße
EarlFred

 

Hallo zusammen,

keine der bisher vorgestellten Lösungen berücksichtigt, dass die Rückgabe von Dir nicht unbedingt ein Verzeichnis sein muss. Das mag für den TE auch nicht relevant sein, aber andere Leser sind vielleicht irritiert.

Testmöglichkeiten, ob die Rückgabe von Dir tatsächlich ein Pfad ist

- If (GetAttr("C:\Temp") And vbDirectory) = vbDirectory Then

- oder mit ChDir hineinwechseln. Fehler 76 = Pfad existiert nicht

- oder mit MkDir anlegen. Fehler 75 = Pfad exisitert schon

 

Hallo haklesoft,

stimmt nur bedingt: In einem Ordner können nicht eine Datei und ein Verzeichnis gleichen Namens liegen. Wäre bereits eine Datei mit dem vermeintlichen Ordnernamen vorhanden, löst bei meinem Code die Fehlerbehandlung aus. Dass das kein schöner Stil ist, unterzeichne ich sofort.

Zum Thema Dir siehe auch hier: VB-Tec / System / Datei / Exists - Feststellen, ob Datei bzw. Verzeichnis existiert


Grüße
EarlFred

 

Hallo EarlFred,

Noe, es gibt keine Meldung und keine Behandlung, wenn der letzte Teilpfad bereits als Datei existiert.

 

Hallo haklesoft,

Das habe ich nicht als Gegenstand Deines Einwands verstanden, auch erachtete es auch nicht für maßgeblich für die Fragestellung.

Wenn das "Gesuchte" kein Ordner ist, bricht der Code ab. Er berücksichtigt also indirekt auch den von Dir genannten Fall.

Bezogen auf Dein Edit:
Also bei mir gibt es in dem Fall, dass der "Pfad" als Dateiname bereits existiert, den Fehler #52 "Dateiname oder -nummer falsch"

Getestet an:
"C:\temp\1\2\3" und "C:\temp\1\2"
wobei "2" einmal ein Ordner und einmal eine Datei (ohne Endung) war und einmal mittig und einmal am Ende des Pfades stand.

Vielleicht noch als Hinweis: Der Code führt den Befehl Dir mit
"C:\temp\1\2\" aus und nicht mit "C:\temp\1\2", was den Fehler provoziert.

Wäre dennoch eine interessante Frage, ob es Konstellationen gibt, die ich nicht bedacht habe. Spätestens dann wäre es Zeit, auf vb-tec zu hören... *wink.gif*

Grüße
EarlFred

 

Hallo EarlFred,

hier mein Testablauf:

Ich habe Deinen Beispielcode (mit dem Pfad "C:\temp\meinOrdner\testverzeichnis\heute") ausgeführt.
Da bekomme ich die Meldung "der Pfad existiert". Ja, das trifft zu, denn die Unterroutine hat gerade alle Pfade angelegt.

Dann habe ich den "heute"-Pfad gelöscht und statt dessen eine Datei "heute" angelegt.
Danach habe ich wieder den Beispielcode ausgeführt, der nun aber stille schweigt, obwohl es den heute-Pfad nicht mehr gibt.

Auch wenn ich den Verzeichnisbaum ab "meinOrdner" ganz lösche und unter "C:\Temp" eine Datei "meinOrdner" anlege und den Code ausführe bleibt alles ruhig, obwohl nun der ganze Unterbaum nicht angelegt wird.

Ja, die Unterroutine hängt immer brav ein "\" an. Damit wird die sperrende Datei zwar nicht gefunden, aber das Pfadanlegen scheitert ggf. und die Routine liefert True zurück.
Als Ergänzung würde ich einen Hinweis geben im Stile von "Halt, Stopp: der gewünschte Verzeichnisbaum konnte nicht vollständig angelegt werden" und für jeden Teilpfad testen, ob es sich um ein Verzeichnis handelt und ab wann das Anlegen scheitert.

 

Hallo haklesoft,

also besteht Dein Einwand darin, dass ich der Einfachheit halber nur den positiven Fall, also dass der Pfad existiert oder angelegt werden konnte, ausgewertet habe? Es ist doch nur ein simples Beispiel gewesen und zeigt das, was den TE interessiert hat (Speichern, wenn Ordner vorhanden) - und das "Gegenteil" auszuwerten ist doch ebenso einfach zu ergänzen, wenn es einem nicht auf Differenziertheit bei der Auswertung eines Fehlers ankommt. Wollte man dies, wäre es mit der Frage, ob eine Datei mit Namen des gewünschten Verzeichnisses existiert, dann aber auch nicht getan.

Bisher habe ich keinen Hinweis darauf erhalten, dass die Function an sich unzuverlässig arbeitet. Genau dieser Fall wäre also interessant, den provoziert aber auch Dein Vorgehen nicht.

Grüße
EarlFred

 

Hi,
danke erstmal für eure rege Beteiligung an meinem Problem. Ich glaube dass ich dies aber nochmals darstellen muss.

Beim Ausführen des "Speichern unter" Makros soll abgefragt werden was in Zelle B5 steht, dies soll auch der Name des zu erstellenden Ordners sein. Daraufhin soll geprüft werden ob dieser Ordner schon im Standardverzeichniss C:\Temp existiert. Wenn nicht soll er erstellt werden, und in diesem Ordner dann die Tabelle abgespeichert werden. Wenn er schon existiert soll die Tabelle ebenfalls dort gespeichert werden.
Der Tabellenname soll folgendermasen zusammengesetzt sein: Datei = Format(Date, "yymmdd_") & Range("B2") & "_Nummer._" & Range("B5") & ".xlsm"

Gruß Rooki

 

Hallo ?,

dann nimmst Du einfach mal meine Function (schon ausprobiert?? Die Function solltest Du mit in das Modul kopieren) und schreibst die paar Zeilen zusammen:

Code:

Den Dateinamen zum Speichern hast Du ja bereits und nun auch die Gewissheit, ob der Pfad existiert (oder eben nicht). Und wenn Du nicht sicher bist, wie Du speichern sollst, liest Du bei Ron nach:
Use VBA SaveAs in Excel 2007-2016

Grüße
EarlFred

 

Hi,

habe deine Funktion ausprobiert, sieht jetzt so aus:

PHP:

         Option Explicit

Sub testaufruf()
Dim strPfad As String
If ActiveSheet.Range("B5").Value <> "" Then
strPfad = "C:\Temp\meinOrdner\" & ActiveSheet.Range("B5").Value

If chkDir(strPfad) Then
MsgBox "Der Pfad " & strPfad & " existiert (nun)."
'Code zum Sichern
Else
MsgBox "Au weia! Der Pfad kann nicht angelegt werden? Was ist da los?", vbCritical, "Noch größere Panik!"
End If

Else
MsgBox "HILFEEEE! In B5 des aktiven Blatt steht ja garnix! Wie willst Du mit nichts einen Pfad anlegen???", vbCritical, "Panik!"
End If
End Sub

Private Function chkDir(ByVal strPfad As String) As Boolean
Dim fVerz As Variant, i As Long, strPfadTemp As String

If Right(strPfad, 1) = "" Then strPfad = Left(strPfad, Len(strPfad) - 1)
fVerz = Split(strPfad, "")
On Error GoTo errExit

For i = LBound(fVerz) To UBound(fVerz)
strPfadTemp = strPfadTemp & fVerz(i) & ""
If Len(Dir(strPfadTemp, vbDirectory)) = 0 Then MkDir strPfadTemp
Next i

errExit:
chkDir = Err = 0
End Function

Sub Speichern_unter()

Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant

Verzeichnis = "C:TempmeinOrdner" 'Verzeichnis-Vorschlag
Datei = Format(Date, "yymmdd_") & Range("B2") & "_Nummer._" & Range("B5") & ".xlsm"  'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Datei)
If SaveDummy <> False Then ActiveWorkbook.SaveAs SaveDummy 'Es wurde im Dialog auf Speichern gedrückt

End Sub

Function SpeichernUnter(VorgabeName As String) As Variant

SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsm),*.xls*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")

End Function


 

Hallo,

wo ist das Problem, die Zeile zum Speichern an der extra für diesen Zweck von mir kommentierten Stelle einzufügen?

Code:

Grüße
EarlFred