Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1120to1124
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Wie heißt Speichern unter nur mit Pfadauswahl?

Wie heißt Speichern unter nur mit Pfadauswahl?
Jörg-HH
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
AW: Wie heißt Speichern unter nur mit Pfadauswahl?
12.12.2009 21:09:01
Hajo_Zi
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

Anzeige
hmm- muß irgendwie noch was Kürzeres geben...
12.12.2009 21:16:34
Jörg-HH
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
AW: hmm- muß irgendwie noch was Kürzeres geben...
12.12.2009 21:23:04
Hajo_Zi
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
Anzeige
das meinte ich...
12.12.2009 22:03:12
Jörg-HH
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
AW: das meinte ich...
12.12.2009 22:05:55
Hajo_Zi
Hallo Jög,
so würde ich das nicht aufbauen, es könnte ja auch sein das jemand Abbricht.
Gruß Hajo
noch paar Details...
12.12.2009 22:38:47
Jörg-HH
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
Anzeige
AW: das meinte ich...
12.12.2009 22:13:16
Josef
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

Anzeige
AW: das meinte ich...
12.12.2009 22:41:31
Jörg-HH
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
Fehler 400
12.12.2009 22:49:27
Jörg-HH
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
AW: Fehler 400
12.12.2009 23:19:00
Josef
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

Anzeige
bleiben noch zwei Fragen...
12.12.2009 23:31:48
Jörg-HH
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
AW: bleiben noch zwei Fragen...
12.12.2009 23:46:20
Josef
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

Anzeige
hmm- kann man Speichern von SpeichernUnter ...
13.12.2009 00:03:31
SpeichernUnter
...noch unterscheiden? Speichern kann er ja meinetwegen - nur einen anderen Namen soll er nicht vergeben können...
Grüße - Jörg
AW: hmm- kann man Speichern von SpeichernUnter ...
13.12.2009 00:08:39
SpeichernUnter
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

Anzeige
bin begeistert...
13.12.2009 00:39:12
Jörg-HH
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

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige