Anzeige
Archiv - Navigation
1556to1560
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

GetSaveAsFilename: Fixer InitialFileName möglich

GetSaveAsFilename: Fixer InitialFileName möglich
18.05.2017 13:47:08
Zacharias
Hallo hilfreiche Excel-Gemeinde,
ich hätte eine Frage, von der ich hoffe, daß es eine einfache Lösung gibt.
In unserer Firma werden Excel-Dateien genutzt, deren VBA-Code ich entwickelt habe.
Ich fange das SaveAs–Ereignis ab und lasse den User auswählen, ob er eine VORLAGE oder ein DOKUMENT
speichern will (hat nichts mit Excel-eigenen Vorlagen zu tun).
Wählt er VORLAGE, soll der Dateiname einer bestimmten Notation entsprechen.
Z.B. VORLAGE_E1_002_BESCHREIBUNG.
Die Userform, mit den entsprechenden Textboxen, die bei Eingabe die Gültigkeit prüfen, ist fertig und funktioniert soweit.
Den geprüften Dateinamen übergebe ich an den GetSaveAsFilename-Dialog
(P.S. excel 2003 wird erzwungen, weil unser Dokumentenmanagementsystem mit 4stelligen extensions nicht klar kommt):
varWorkbookName = Application.GetSaveAsFilename(InitialFileName:=strSaveAsFilename, _
FileFilter:="Excel 97-2003-Workbook (*.xls), *.xls")
Nun meine Frage: Gibt es die Möglichkeit, den GetSaveAsFilename-Dialog so zu konfigurieren, daß der Initialfilename
NICHT geändert werden kann? Denn sonst wäre die vorher durchgeführte Notationsprüfung ziemlich sinnlos.
Ich würde gern den GetSaveAsFilename-Dialog (oder ähnlich) nutzen, damit der User beim Speichern ein bekannten Dialog
zum Browsen in der Verzeichnisstruktur vorfindet und auch die enthaltenen Dateien sieht, die sich im jeweiligen Verzeichnis befinden.
Ich bin für jeden auch alternativen Hinweis wie immer sehr dankbar.
Sommerliche Grüße (29 Grad im Schatten) in die Runde.
Zacharias

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
GetSaveAsFilename: Fixer InitialFileName möglich
18.05.2017 14:31:44
Nepumuk
Hallo,
wenn du nur einen Ordner bestimmen willst, dann benutze doch einfach einen entsprechenden Dialog. Welcher geht ist aber abhängig von der verwendeten Excelversion.
Gruß
Nepumuk
AW: GetSaveAsFilename: Fixer InitialFileName möglich
18.05.2017 15:00:09
Zacharias
Hallo Nepumuk,
Danke für die prompte Antwort.
Einen normalen Verzeichnisdialog finde ich nicht so gut, weil der Nutzer nicht direkt im Dialog erkennt, welche Datei unter welchem Namen er in welchem Umfeld speichert.
Ist schon hilfreich, wenn er erkennt, wieviele andere Vorlagen (aktuell haben wir an die 400) bereits im jeweiligen Verzeichnis liegen und unter welchen Dateinamen.
Am hilfreichsten – als Fertiglösung - wäre da m.E. noch der FileDialog:
Sub Verzeichnis()
Dim ordner As FileDialog, Pfad As String
Set ordner = Application.FileDialog(msoFileDialogFolderPicker)
If ordner.Show = -1 Then
Pfad = ordner.SelectedItems(1)
End If
MsgBox Pfad
Set ordner = Nothing
End Sub
Aber, damit ich dort die Dateien im Verzeichnis sehe, müßte ich als MsoFileDialogType 1,3 oder4 konfigurieren,
was aber m.E. nicht das Ergebnis liefert, welches ich gern hätte:
- Verzeichnis selektieren
- Verzeichnisinhalte sehen
- vorgegebenen Dateinamen sehen und nicht verändern können
MsoFileDialogType kann eine dieser MsoFileDialogType-Konstanten sein:
1: msoFileDialogFilePicker. Ermöglicht es Benutzern, eine Datei auszuwählen.
2: msoFileDialogFolderPicker. Ermöglicht es Benutzern, einen Ordner auszuwählen.
3: msoFileDialogOpen. Ermöglicht es Benutzern, eine Datei zu öffnen.
4: msoFileDialogSaveAs. Ermöglicht es Benutzern, eine Datei zu speichern.
Oder habe ich etwas übersehen?
Viele Grüße
Zacharias
Anzeige
GetSaveAsFilename: Fixer InitialFileName möglich
18.05.2017 15:09:43
Nepumuk
Hallo,
das geht auch mit Dateianzeige:
' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" ( _
    ByVal DirPath As String) As Long
Private Declare Function MoveWindow Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal bRepaint As Long) As Long
Private Declare Function GetSystemMetrics Lib "user32.dll" ( _
    ByVal nIndex As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByRef lpRect As RECT) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" ( _
    ByRef lpbi As InfoT) As Long
Private Declare Function CoTaskMemFree Lib "ole32.dll" ( _
    ByVal hMem As Long) As Long
Private Declare Function lstrcat Lib "kernel32.dll" Alias "lstrcatA" ( _
    ByVal lpStr1 As String, _
    ByVal lpStr2 As String) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" ( _
    ByVal pList As Long, _
    ByVal lpBuffer As String) As Long
Private Declare Function SendMessageA Lib "user32.dll" ( _
    ByVal hwnd As Long, _
    ByVal Msg As Long, _
    ByRef wParam As Any, _
    ByRef lParam As Any) As Long
Private Declare Function ILCreateFromPath Lib "shell32.dll" Alias "#157" ( _
    ByVal sPath As String) As Long

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 Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Const BIF_RETURNONLYFSDIRS = &H1
Private Const BIF_DONTGOBELOWDOMAIN = &H2
Private Const BIF_STATUSTEXT = &H4
Private Const BIF_RETURNFSANCESTORS = &H8
Private Const BIF_EDITBOX = &H10
Private Const BIF_VALIDATE = &H20
Private Const BIF_NEWDIALOGSTYLE = &H40
Private Const BIF_BROWSEINCLUDEURLS = &H80
Private Const BIF_BROWSEFORCOMPUTER = &H1000
Private Const BIF_BROWSEFORPRINTER = &H2000
Private Const BIF_BROWSEINCLUDEFILES = &H4000
Private Const BIF_SHAREABLE = &H8000

Private Const SM_CXFULLSCREEN = &H10
Private Const SM_CYFULLSCREEN = &H11

Private Const BFFM_SETSELECTION = &H466
Private Const BFFM_INITIALIZED = &H1

Private lstrInitDir As String

Private Function GetFolder( _
        Optional ByVal opvstrMsg As String = "Bitte wählen Sie ein Verzeichnis", _
        Optional ByVal opvlngFlag As Long = BIF_RETURNONLYFSDIRS, _
        Optional ByVal opvstrInitDir As String = "C:\", _
        Optional ByVal opvstrOnlyInRoot As String = vbNullString) As String

    
    Dim udtInfo As InfoT
    Dim lngIDList As Long, lngReturn As Long
    Dim strPath As String
    
    lstrInitDir = opvstrInitDir
    
    With udtInfo
        
        .hwnd = Application.hwnd
        .Root = ILCreateFromPath(StrConv(opvstrOnlyInRoot, vbUnicode))
        .Title = lstrcat(opvstrMsg, "")
        .Flags = opvlngFlag
        .FName = Callback(AddressOf BrowseCallback)
        
    End With
    
    lngIDList = SHBrowseForFolder(udtInfo)
    
    If lngIDList <> 0 Then
        
        strPath = Space$(256)
        Call SHGetPathFromIDList(lngIDList, strPath)
        Call CoTaskMemFree(lngIDList)
        strPath = Trim$(strPath)
        strPath = Left$(strPath, Len(strPath) - 1)
        
    End If
    
    GetFolder = strPath
    
End Function

Private Function BrowseCallback( _
        ByVal pvlngHwnd As Long, _
        ByVal pvlngMsg As Long, _
        ByVal pvlngwParam As Long, _
        ByVal pvlnglParam As Long) As Long

    
    If pvlngMsg = BFFM_INITIALIZED Then
        
        Call SendMessageA(pvlngHwnd, BFFM_SETSELECTION, _
            ByVal 1&, ByVal lstrInitDir)
        Call CenterDialog(pvlngHwnd)
        
    End If
    
    BrowseCallback = 0
    
End Function

Private Function Callback( _
        ByVal pvlngParam As Long) As Long

    
    Callback = pvlngParam
    
End Function

Private Sub CenterDialog( _
        ByVal pvlngHwnd As Long)

    
    Dim udtWinRect As RECT
    Dim lngScrWidth As Long, lngScrHeight As Long
    Dim lngDlgWidth As Long, lngDlgHeight As Long
    
    Call GetWindowRect(pvlngHwnd, udtWinRect)
    
    lngDlgWidth = udtWinRect.Right - udtWinRect.Left
    lngDlgHeight = udtWinRect.Bottom - udtWinRect.Top
    
    lngScrWidth = GetSystemMetrics(SM_CXFULLSCREEN)
    lngScrHeight = GetSystemMetrics(SM_CYFULLSCREEN)
    
    Call MoveWindow(pvlngHwnd, (lngScrWidth - lngDlgWidth) / 2, _
        (lngScrHeight - lngDlgHeight) / 2, lngDlgWidth, lngDlgHeight, 1)
    
End Sub

Public Sub test()
    
    Const PRE_SELECT As String = "C:\Users\Public\"
    
    Dim strFolder As String
    
    If Cbool(MakeSureDirectoryPathExists(PRE_SELECT)) Then
        strFolder = GetFolder("Zielverzeichnis auswählen", BIF_BROWSEINCLUDEFILES, PRE_SELECT)
        If strFolder <> "" Then MsgBox strFolder
    Else
        MsgBox "Kein Zugriff auf Ordner " & PRE_SELECT
    End If
    
End Sub

Gruß
Nepumuk
Anzeige
AW: GetSaveAsFilename: Fixer InitialFileName möglich
18.05.2017 15:41:19
Zacharias
Hallo Nepumuk,
das ist genial, schöner TreeView mit Verzeichnissen und Dateien und Icons!
Den Code nutze ich gern – vielen vielen Dank!
Du bist schon zu Recht eine „lebende Legende“ hier.
Viele Grüße
Zacharias

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige