Dialogfeld Speichern unter

Hallo Zusammen
Ich möchte gerne folgendes realisieren.
Habe als Beispiel auf dem Laufwerk D:\Temp mehrere unterschiedliche Ordner mit unterschiedlicher Ordnerbenennung wie
0X001_Ordner1
0X002_OrdnerABC
0X003_Ordner XYZ
In diesen Ordnern gibt es jeweils immer den gleichen Unterordner.
Beispiel: 0X001_Ordner1\Unterordner
Jetzt möchte ich aus einem Excel sheet in einer Zelle z. B 0X001 eingeben und über ein Command Button folgende Befehle ausführen um den Pfad in einem Dialogfeld Speichern unter (Application.GetSaveAsFilename) einzutragen.
Suche im Laufwerk D:\Temp den Ordner aus der Zelle. In diesem Fall 0X001. Es sollte aber nur nach den ersten fünf Digits gesucht werden.
Wenn der Ordner vorhanden ist nutze den kompletten Pfad und trage noch das Unterverzeichnis mit dazu (D:\Temp\0X001_Ordner1\Unterordner).Öffne das Dialogfeld Speichern unter (Application.GetSaveAsFilename) mit dem Dateipfad. Vergebe den Vorschlagsnamen Testdatei.
Wenn der Ordner nicht vorhanden ist dann öffne eine Msgbox Der Ordner bzw. Laufwerk ist nicht vorhanden ->Abbruch
Konnte folgende Quellcode bis dato schreiben:

Sub Speichern_unter()
'Deklaration der Variablen
Dim Dateiname$
'Verzeichnis
ChDir ("D:\Temp))
'Laufwerkspfad
ChDrive "D"
'Dateinamen festlegen
Dateiname = ("Testdatei")
'Dialogfeld mit vorgegebenen Dateinamen und Pfad
AusgewählterName = Application.GetSaveAsFilename(Dateiname, "Excel-Arbeitsmappe (*.xlsm), *.xls" _
_
)
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Speichern_unter() 'Deklaration der Variablen Dim Ordner$, Pfad$, dirPfad$ Dim wahlPfad ' wenn, dann bitte *alle* Ordner = Range("C2") ' das steht eben 0x001 Pfad = "C:\Dein_Ordner\" dirPfad = Dir(Pfad & Ordner & "*", vbDirectory) If Len(dirPfad) > 0 Then wahlPfad = Application.GetSaveAsFilename(Pfad & dirPfad, _ "Excel-Arbeitsmappe (*.xls*), *.xls*") MsgBox wahlPfad ' Abbruch gedrückt? usw. ' weitere Aktionen Else MsgBox "Ordner " & Pfad & " nicht gefunden." Exit Sub End If End Sub

Sub Speichern_unter() 'Deklaration der Variablen Dim Ordner$, Pfad$, dirPfad$, untPfad$ Dim wahlPfad Const UnterOrdner = "\Unterordner\" Ordner = Range("C2") ' das steht eben 0x001 Pfad = "C:\Dein_Ordner\" dirPfad = Dir(Pfad & Ordner & "*", vbDirectory) If Len(dirPfad) > 0 Then untPfad = Dir(Pfad & dirPfad & UnterOrdner, vbDirectory) Else MsgBox "Ordner " & Pfad & dirPfad & UnterOrdner & " nicht gefunden." Exit Sub End If If Len(untPfad) > 0 Then wahlPfad = Application.GetSaveAsFilename _ (Pfad & dirPfad & UnterOrdner, _ "Excel-Arbeitsmappe (*.xls), *.xls") MsgBox wahlPfad ' Abbruch gedrückt? usw. ' weitere Aktionen Else MsgBox "Ordner " & Pfad & " nicht gefunden." Exit Sub End If End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread