VBA Ordner erstellen falls nicht vorhanden und Datei speichern
10.02.2020 11:09:42
Chris
Ich habe ein Problem mit einer Datei die ein Makro enthält das mein Vorgänger vor ein paar Jahren erstellt hat und hoffe das hier jemand ist der mir damit helfen kann!
Bei mir sind so gut wie keine Makro-Kenntnisse vorhanden! An dieser Stelle auch gleich die Frage: Wer kennt ein gutes Buch das mich in die VBA Welt einführt!!
Zu meinem Problem:
Ich möchte eine Datei in einem bestimmten Verzeichnis speichern. Das Stammverzeichnis ist dabei immer das gleiche.
Jährlich muss einmal ein Ordner für das laufende Jahr erstellt werden sobald die erste Datei erstellt wird.
Innerhalb diese Ordner müssen nun wiederum Unterordner erstellt werden welche die ersten 8 Zeichen des Dateinamens haben sollen.
In diesem Ordner wiederum soll dann die Datei abgelegt werden!
Die Werte werden alle aus Zellen in der Datei ausgelesen.
Beispiel:
Datei1 "X:\2020\RL200001\RL200001 - yy - xxxxxxx.xlsx"
Datei2 "X:\2020\RL200002\RL200002 - ab - wsadcx.xlsx"
Dat....
Stammverzeichnis: "X:\" ==> Zelle BQ55
Variabler Ordner: "2020" für das Jahr 2020 ==> Zelle BQ58
Unterordner: "RL200001" = die ersten 8 Zeichen des Dateinamens. Diese Nummer ist immer fortlaufend und setzt sich aus den letzten beiden Zeichen des aktuellen Jahres und einer fortlaufenden Nummer zusammen und wird aus einem Teil der Zelle BQ61 generiert
Dateiname: "RL200001 - yy - xxxxxxx" ==> Zelle BQ61
Wenn der variable Ordner schon vorhanden ist soll direkt ein Unterordner erstellt und die neue Datei darin abgelegt werden.
Bisher funktioniert das Makro so das der Name der Datei autom. erstellt und der User dann aufgefordert wird den Speicherpfad aussuchen.
In dem variablen Ordner muss er dann den betreffenden Unterordner erstellen und die Datei darin speichern.
In der Vergangenheit hatte ich dann öfters das Problem das die Dateiene in falschen Ordner waren oder die Ordner nicht den Namensvorgaben entsprachen und ich immer aller Ordner durchsuchen musste.
Das Makro das hier bisher verwendet wurde ist folgendes:
'Aufruf über Modul1
Public Sub CommandButton1_Click()
Dim Datei As String
Dim Verzeichnis As String
Dim SaveDummy As Variant
'blendet die Schaltfäche aus
Worksheets("dokname").Unprotect Password:="XXXX"
ActiveWorkbook.ActiveSheet.Shapes("CommandButton1").Visible = False
Worksheets("dokname").Protect Password:="XXXX"
Verzeichnis = "F:\RL\" 'Verzeichnis-Vorschlag
Datei = "RL" & Range("BQ61") & ".xlsx" 'Datei-Vorschlag
SaveDummy = SpeichernUnter(Verzeichnis & Ordner & Datei)
If SaveDummy False Then ActiveWorkbook.SaveAs SaveDummy Else ActiveWorkbook.ActiveSheet. _
Shapes("CommandButton1").Visible = True 'Es wurde im Dialog auf Speichern gedrückt
End Sub
'Fragt den gewünschten Dateinamen ab und gibt ihn mit Pfad als String @Vorgabename zurück
Private Function SpeichernUnter(VorgabeName As String) As Variant
SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel _
_
Dateien (*.xlsx),*.xlsx*", _
FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
End Function
'Methode zum Testen des show/hide Befehls
Private Sub showHideButton()
ActiveWorkbook.ActiveSheet.Shapes("CommandButton1").Visible = True
End Sub