Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Image
BildScreenshot zu Image Image-Seite mit Beispielarbeitsmappe aufrufen

Wie heißt Speichern unter nur mit Pfadauswahl? | Herbers Excel-Forum


Betrifft: Wie heißt Speichern unter nur mit Pfadauswahl? von: Jörg-HH
Geschrieben am: 12.12.2009 21:04:57

Guten Abend zusammen

vor einiger Zeit war ich mal auf einen Speichern-unter-Dialog gestoßen, bei dem der Dateiname vorgegeben sein kann und gar nicht zu sehen ist. Der User kann nur einen beliebigen Ordner auswählen.

Ich weiß nicht mehr, wie das Ding in VBA heißt und kann demnach auch nicht gescheit danach suchen. Kann mir jemand auf die Sprünge helfen?

Danke für'n Tip...
Jörg

  

Betrifft: AW: Wie heißt Speichern unter nur mit Pfadauswahl? von: Hajo_Zi
Geschrieben am: 12.12.2009 21:09:01

Hallo Jörg,

Ordnerauswah

Option Explicit
Option Private Module
' Projekt weit
Public StOrdner As String           ' Suchordner
'   von Nepumuk
Private Type InfoT
    hwnd As Long
    Root As Long
    DisplayName As Long
    Title As Long
    Flags As Long
    FName As Long
    lParam As Long
    Image As Long
End Type

Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32" (ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpStr1 As String, ByVal  _
lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pList As Long, ByVal lpBuffer  _
As String) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassname As  _
String, ByVal lpWindowName As String) As Long

Function GetAOrdner() As String
    Dim xl As InfoT, IDList As Long, RVal As Long, FolderName As String
    With xl
        .hwnd = FindWindow("xlmain", vbNullString)
'        .hwnd = FindWindow("", "Auswahl")  ' Userform Auswahl
        .Title = lstrcat("Bitte wählen Sie ein Verzeichnis", "")
        .Flags = 1
    End With
    IDList = SHBrowseForFolder(xl)
    If IDList <> 0 Then
        FolderName = Space(256)
        RVal = SHGetPathFromIDList(IDList, FolderName)
        CoTaskMemFree (IDList)
        FolderName = Trim(FolderName)
        FolderName = Left(FolderName, Len(FolderName) - 1)
    End If
    GetAOrdner = FolderName
End Function

'   nicht verwendeter Code
'   Aufruf mit
Sub test()
    StOrdner = GetAOrdner                       ' Verzeichnis auswählen
End Sub
GrußformelHomepage


  

Betrifft: hmm- muß irgendwie noch was Kürzeres geben... von: Jörg-HH
Geschrieben am: 12.12.2009 21:16:34

Hallo Hajo,
das ging ja blitzartig. Danke erstmal - nur den Code versteh' ich leider nicht. Es muß auch noch was Anderes geben, etwas Kurzes ähnlich GetSaveAsFilename oder so. Ich hatte das schon mal verwendet und gesehen, wie es aussieht, dann aber dort doch nicht eingebaut. Und das war damals ganz einfach, auch für VBA-Lernlinge bedienbar :-)

Grüße, Jörg


  

Betrifft: AW: hmm- muß irgendwie noch was Kürzeres geben... von: Hajo_Zi
Geschrieben am: 12.12.2009 21:23:04

Hallo Jötg,

versuch2

Option Explicit

'*******************************
' von Matthias G
Function GetFolder() As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .InitialFileName = "C:\"
        .ButtonName = "OK"
        .Title = "Titelzeile"
        .Show
        If .SelectedItems.Count = 0 Then
            GetFolder = ""
        Else
            GetFolder = .SelectedItems(1)
        End If
    End With
End Function
'*******************************
Sub Joerg()
    MsgBox GetFolder
End Sub

Gruß Hajo


  

Betrifft: das meinte ich... von: Jörg-HH
Geschrieben am: 12.12.2009 22:03:12

genau das isses, Hajo - FolderPicker

wenn ich die aktuelle Datei nun unter dem gewählten Pfad speichern will - heißt das dann ActiveWorkbook.SaveAs GetFolder oder so ähnlich?

Gruß - Jörg


  

Betrifft: AW: das meinte ich... von: Hajo_Zi
Geschrieben am: 12.12.2009 22:05:55

Hallo Jög,

so würde ich das nicht aufbauen, es könnte ja auch sein das jemand Abbricht.

Gruß Hajo


  

Betrifft: noch paar Details... von: Jörg-HH
Geschrieben am: 12.12.2009 22:38:47

Hallo Hajo,
hab mir da jetzt was zusammengebastelt. Paar Kleinigkeiten noch:

- Wie heißt Abbruch bei dem Dialog in VBA - ist das dann "" ?
- wie krieg ich den ausgewählten Ordner in das Anzeigefeld unten?
- die Datei wird kommentarlos eine über die andere gespeichert. Kann man da ein "wollen Sie ersetzen" oder so wie gewohnt aktivieren für den Fall, daß sie schon mal gespeichert wurde?

Grüße - Jörg


  

Betrifft: AW: das meinte ich... von: Josef Ehrensberger
Geschrieben am: 12.12.2009 22:13:16

Hallo Jörg,

das geht z.B. so.

' **********************************************************************
' Modul: Modul4 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Function GetFolder(Optional Path As String = "", Optional Title As String = "") As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = Path
    .ButtonName = "OK"
    .Title = IIf(Len(Title), Title, "Ordner wählen")
    .Show
    If .SelectedItems.Count = 0 Then
      GetFolder = ""
    Else
      GetFolder = .SelectedItems(1)
    End If
  End With
End Function

Sub saveFile()
  Dim strFileName As String, strPath As String
  
  strFileName = "DeineDateiName.xls"
  
  strPath = GetFolder("C:\", "Wählen Sie einen Ordner")
  
  If Len(strPath) Then
    ActiveWorkbook.SaveAs strPath & "\" & strFileName
  End If
  
End Sub



Gruß Sepp



  

Betrifft: AW: das meinte ich... von: Jörg-HH
Geschrieben am: 12.12.2009 22:41:31

Hallo Sepp
deine Antwort und meine Nachfrage an Hajo hat sich grad überschnitten, weil ich kurz weg war - ich probier das mal eben aus...

Gruß Jörg


  

Betrifft: Fehler 400 von: Jörg-HH
Geschrieben am: 12.12.2009 22:49:27

Hi Sepp
hier kommt die Abfrage, ob ersetzt werden soll. Wenn ich allerdings auf Nein klicke, erscheint eine Msgbox mit VBA und nur der Zahl 400, sonst nichts

Grüße - Jörg


  

Betrifft: AW: Fehler 400 von: Josef Ehrensberger
Geschrieben am: 12.12.2009 23:19:00

Hallo Jörg,

dann muss man diesen Fehler halt abfangen.

' **********************************************************************
' Modul: Modul4 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Function GetFolder(Optional Path As String = "", Optional Title As String = "") As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = Path
    .ButtonName = "OK"
    .Title = IIf(Len(Title), Title, "Ordner wählen")
    .Show
    If .SelectedItems.Count = 0 Then
      GetFolder = ""
    Else
      GetFolder = .SelectedItems(1)
    End If
  End With
End Function

Sub saveFile()
  Dim strFileName As String, strPath As String
  
  On Error GoTo ErrExit
  Application.DisplayAlerts = False
  
  strFileName = "deinedatei.xls"
  
  strPath = GetFolder("C:\" & strFileName, "Wählen Sie einen Ordner")
  
  If Len(strPath) Then
    If Dir(strPath & "\" & strFileName, vbNormal) <> "" Then
      If MsgBox("Die Datei" & vbLf & vbLf & strPath & "\" & strFileName & vbLf & _
        vbLf & "ist bereits vorhanden!" & vbLf & "Soll die Datei ersetzt werden?", _
        vbQuestion + vbYesNo, "Speichern") = vbNo Then Exit Sub
    End If
    ActiveWorkbook.SaveAs strPath & "\" & strFileName
  End If
  
  ErrExit:
  Application.DisplayAlerts = True
End Sub



Gruß Sepp



  

Betrifft: bleiben noch zwei Fragen... von: Jörg-HH
Geschrieben am: 12.12.2009 23:31:48

Hallo Sepp,
das klappt ja wie geschmiert.
Eine "alte" Frage war da noch: wie krieg ich den ausgewählten Ordner in das Anzeigefeld unten in Dialog?

und eine "neue", die mir grad aufgefallen ist:
Das Ganze dient ja dazu, einen vom Code vorgegebenen Dateinamen zu erzwingen. Jetzt merke ich, daß der User ja ohne weiteres seinen Excel-Speichern-unter-Button klicken und alles umgehen kann. Wie heißt das denn in VBA, wenn er da klickt? Daran würde ne MsgBox hängen wollen mit dem netten hinweis "nimm den mitgelieferten Speichern-Button"

Grüße - Jörg


  

Betrifft: AW: bleiben noch zwei Fragen... von: Josef Ehrensberger
Geschrieben am: 12.12.2009 23:46:20

Hallo Jörg,

zu 1.: Meines Wissens gar nicht, zumindest nicht mit diesem Dialog.

Zu 2.: Dazu braucht man eine öffentliche Variable und ein paar Zeilen Code unter "DieseArbeitsmappe"

' **********************************************************************
' Modul: Modul4 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public blnSave As Boolean

Private Function GetFolder(Optional Path As String = "", Optional Title As String = "") As String
  With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .InitialFileName = Path
    .ButtonName = "OK"
    .Title = IIf(Len(Title), Title, "Ordner wählen")
    .Show
    If .SelectedItems.Count = 0 Then
      GetFolder = ""
    Else
      GetFolder = .SelectedItems(1)
    End If
  End With
End Function

Sub saveFile()
  Dim strFileName As String, strPath As String
  
  On Error GoTo ErrExit
  Application.DisplayAlerts = False
  
  strFileName = "deinedatei.xls"
  
  strPath = GetFolder("C:\" & strFileName, "Wählen Sie einen Ordner")
  
  If Len(strPath) Then
    If Dir(strPath & "\" & strFileName, vbNormal) <> "" Then
      If MsgBox("Die Datei" & vbLf & vbLf & strPath & "\" & strFileName & vbLf & _
        vbLf & "ist bereits vorhanden!" & vbLf & "Soll die Datei ersetzt werden?", _
        vbQuestion + vbYesNo, "Speichern") = vbNo Then Exit Sub
    End If
    blnSave = True
    ActiveWorkbook.SaveAs strPath & "\" & strFileName
    blnSave = False
  End If
  
  ErrExit:
  Application.DisplayAlerts = True
End Sub


' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  If Not blnSave Then
    Cancel = True
    MsgBox "Speichern nur über die dafür vorgesehene Schaltfläche!", _
      vbInformation, "Speichern"
  End If
End Sub



Gruß Sepp



  

Betrifft: hmm- kann man Speichern von SpeichernUnter ... von: Jörg-HH
Geschrieben am: 13.12.2009 00:03:31

...noch unterscheiden? Speichern kann er ja meinetwegen - nur einen anderen Namen soll er nicht vergeben können...

Grüße - Jörg


  

Betrifft: AW: hmm- kann man Speichern von SpeichernUnter ... von: Josef Ehrensberger
Geschrieben am: 13.12.2009 00:08:39

Hallo Jörg,

auch das geht.

' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
  If SaveAsUI Then
    If Not blnSave Then
      Cancel = True
      MsgBox "Speichern nur über die dafür vorgesehene Schaltfläche!", _
        vbInformation, "Speichern"
    End If
  End If
End Sub



Gruß Sepp



  

Betrifft: bin begeistert... von: Jörg-HH
Geschrieben am: 13.12.2009 00:39:12

Hallo Sepp,
klappt!

Muß noch bissl nachdenken über blnSave und SaveAsUI - so richtig hab ich das noch nicht kapiert, aber wichtig ist erstmal, daß es läuft...

Dank dir!

und Gute Nacht

Jörg


Beiträge aus den Excel-Beispielen zum Thema "Wie heißt Speichern unter nur mit Pfadauswahl?"