Verzeichnis auswählen
20.08.2018 18:09:16
philipp
ich habe folgendes Makro zusammengebastelt, es funktioniert:
Public Sub Speichern_beenden()
Dim OrdNam As String
Dim DateiNam As String
DateiNam = ActiveWorkbook.Name
OrdNam = "C:\Holzbestand"
OrdNam = InputBox("Name Verzeichnis ggf. ändern: ", "Verzeichnis Menü", OrdNam)
If Dir(OrdNam, vbDirectory) = "" Then
MsgBox "Das Verzeichnis: " & OrdNam & Chr(13) & Chr(13) & "ist nicht vorhanden !" _
& Chr(13) & Chr(13) & "Wird jetzt erstellt !"
MkDir OrdNam
Else
'' MsgBox "Das Verzeichnis: " & OrdNam & " ist vorhanden!"
End If
'---------- speichern --------------------------------------------
DateiNam = InputBox("Dateiname ggf. ändern: ", "Dateiname", DateiNam)
MsgBox "Ordner: '" & OrdNam & "' ist vorhanden !" & Chr(13) _
& Chr(13) & "Datei: " & " " & DateiNam & ".xlsm" & " " _
& Chr(13) & Chr(13) & "wird jetzt gespeichert ! ", vbInformation, " Hinweis !"
Application.DisplayAlerts = False ' Sicherheitsabfrage unterdrücken
ActiveWorkbook.SaveAs Filename:=(OrdNam & "\" & DateiNam), FileFormat:= _
xlOpenXMLWorkbookMacroEnabled, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False
Dim Antwort As String
Antwort = MsgBox("Achtung !!!" & Chr(13) & Chr(13) & _
"Möchten Sie die Datei schließen ? " & Chr(13) & _
Chr(13) & Chr(13) & Chr(13) & _
"Schließen: JA drücken", vbCritical + vbYesNo, "Beenden ?")
If Antwort = vbYes Then
ActiveSheet.Range("D12").Select
ActiveWorkbook.Close
Else
MsgBox "Dann arbeite weiter..."
ActiveSheet.Range("D12").Select
End If
Application.DisplayAlerts = True
End Sub
Ich möchte aber zu der Inputbox auch eine Auswahl der vorhandenen Verzeichnisse
auswählen und dann speichern.
Ich glaube das geht nur mit einer kleinen Userform oder ?
Bitte mal einen Vorschlag sofern vorhanden,
würde mich freuen.
mfg
philipp