Access-Paradies|Datei-Öffnen-/Speichern-Dialog

Option Compare Database
Option Explicit
 
Type DateiDialogStruktur
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
End Type
 
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(DateiDialogStruktur As DateiDialogStruktur) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(DateiDialogStruktur As DateiDialogStruktur) As Long
 
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_EXPLORER = &H80000
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0
Public Const OFN_SHOWHELP = &H10
 
Dim DateiDialogStruktur As DateiDialogStruktur
 
Function DateiOeffnen(Verzeichnis As String, Fenstertitel As String) As String
On Error GoTo Err_DateiOeffnen
 
    Dim Dateityp As String
    Dim Dateiname_mit_Pfad As String
    Dim Dateiname As String
    Dim Rueckwerte As Long
 
    Dateityp = ""
 
' Dateitypen in der Auswahlliste des Dateityp's
'   Alle Dateien
    Dateityp = Dateityp & "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
' Access-Dateitypen
    Dateityp = Dateityp & _
    "Microsoft Access-Datenbanken (*.mdb)" & Chr$(0) & "*.mdb" & Chr$(0)
 
    Dateityp = Dateityp & _
    "Add-Ins (*.mda)" & Chr$(0) & "*.mda" & Chr$(0)
 
    Dateityp = Dateityp & _
    "Arbeitsgruppen-Dateien (*.mdw)" & Chr$(0) & "*.mdw" & Chr$(0)
 
    Dateityp = Dateityp & _
    "MDE-Dateien (*.mde)" & Chr$(0) & "*.mde" & Chr$(0)
 
' Word-Dateitypen
'   Word-Dokumente (*.doc)
'   Dokumentenvorlagen (*.dot)
'   Rich Text Format (*.rtf)
'   Textdateien (*.txt)
'   Schedule+-Kontakte (*.scd)
'   Persönliches Adreßbuch (*.pab)
'   Outlook-Adreßbuch (*.olk)
'   MS-DOS Text mit Layout (*.asc)
'   Text mit Layout (*.ans)
'   HTML Document (*.htm;*.html;*.htx)
'   Windows Write (*.wri)
'   Lotus 1-2-3 (*.wk1;*.wk3;*.wk4)
'   WordPerfect 6.x (*.wpd;*.doc)
'   Microsoft Excel-Arbeitsmappen (*.xls)
'   Works 3.0 für Windows (*.wps)
'   Works 4.0 für Windows (*.wps)
 
' Excel-Dateitypen
'   Textdateien (*.prn;*.txt;*.csv)
'   QuattroPro/DOS-Dateien (*.wq1)
'   Microsoft Works 2.0-Dateien (*.wks)
'   dBASE-Dateien (*.dbf)
'   Add-Ins (*.xla;*.xll)
'   Mustervorlagen (*.xlt)
'   Arbeitsbereiche (*.xlw)
'   Tabellen (*.xls)
 
'   Sicherungsdateien (*.xlk;*.bak)
'   HTML-Dateien (*.html;*.htm)
 
 
' Vorgegebenes Verzeichnis
    If Verzeichnis = "" Then
        ' Wenn leer, dann soll das aktuelle Verzeichnis verwendet werden
        Verzeichnis = CurDir$ & Chr$(0)
    Else
        ' ANSI "0" an das übergebene Verzeichnis anhängen
        Verzeichnis = Verzeichnis & Chr$(0)
    End If
 
    If Fenstertitel = "" Then
        ' Wenn kein Titel übergeben worden ist
        Fenstertitel = "Datei öffnen"
    Else
        ' ANSI "0" an übergebenen Fenstertitel anhängen
        Fenstertitel = Fenstertitel & Chr$(0)
    End If
 
' Speicherplatz für Dateieintrag (mit Pfadangabe) reservieren
    Dateiname_mit_Pfad = Space$(255) & Chr$(0)
 
' Speicherplatz für Dateieintrag (ohne Pfadangabe) reservieren
    Dateiname = Space$(255) & Chr$(0)
 
'Datenstruktur von DateiDialogStruktur festlegen
    DateiDialogStruktur.lStructSize = Len(DateiDialogStruktur)
    DateiDialogStruktur.hwndOwner = 0&
    'DateiDialogStruktur.hwndOwner = Application.hWndAccessApp
    DateiDialogStruktur.lpstrFilter = Dateityp
    DateiDialogStruktur.nFilterIndex = 1
    DateiDialogStruktur.lpstrFile = Dateiname_mit_Pfad
    DateiDialogStruktur.nMaxFile = Len(Dateiname_mit_Pfad)
    DateiDialogStruktur.lpstrFileTitle = Dateiname
    DateiDialogStruktur.nMaxFileTitle = Len(Dateiname)
    DateiDialogStruktur.lpstrInitialDir = Verzeichnis
    DateiDialogStruktur.lpstrTitle = Fenstertitel
    DateiDialogStruktur.flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST _
    Or OFN_HIDEREADONLY Or OFN_LONGNAMES
    DateiDialogStruktur.nFileOffset = 0
    DateiDialogStruktur.nFileExtension = 0
    DateiDialogStruktur.lCustData = 0
    DateiDialogStruktur.lpfnHook = 0
    DateiDialogStruktur.lpTemplateName = ""
 
    Rueckwerte = GetOpenFileName(DateiDialogStruktur)
 
    If Rueckwerte <> 0 Then
        DateiOeffnen = Left(DateiDialogStruktur.lpstrFile, _
        InStr(DateiDialogStruktur.lpstrFile, Chr$(0)) - 1)
    End If
 
Exit_DateiOeffnen:
    Exit Function
 
Err_DateiOeffnen:
    MsgBox Err.Description
    Resume Exit_DateiOeffnen
 
End Function
Function DateiSpeichern(Verzeichnis As String, Fenstertitel As String) As String
On Error GoTo Err_DateiSpeichern
 
    Dim Dateityp As String
    Dim Dateiname_mit_Pfad As String
    Dim Dateiname As String
    Dim Rueckwerte As Long
 
' Dateitypen in der Auswahlliste des Dateityp's
'   Alle Dateien
    Dateityp = Dateityp & "Alle Dateien (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
' Access-Dateitypen
    Dateityp = Dateityp & _
    "Microsoft Access-Datenbanken (*.mdb)" & Chr$(0) & "*.mdb" & Chr$(0)
 
    Dateityp = Dateityp & _
    "Add-Ins (*.mda)" & Chr$(0) & "*.mda" & Chr$(0)
 
    Dateityp = Dateityp & _
    "Arbeitsgruppen-Dateien (*.mdw)" & Chr$(0) & "*.mdw" & Chr$(0)
 
    Dateityp = Dateityp & _
    "MDE-Dateien (*.mde)" & Chr$(0) & "*.mde" & Chr$(0)
 
' Vorgegebenes Verzeichnis
    If Verzeichnis = "" Then
        ' Wenn leer, dann soll das aktuelle Verzeichnis verwendet werden
        Verzeichnis = CurDir$ & Chr$(0)
    Else
        ' ANSI "0" an das übergebene Verzeichnis anhängen
        Verzeichnis = Verzeichnis & Chr$(0)
    End If
 
    If Fenstertitel = "" Then
        ' Wenn kein Titel übergeben worden ist
        Fenstertitel = "Datei speichern"
    Else
        ' ANSI "0" an übergebenen Fenstertitel anhängen
        Fenstertitel = Fenstertitel & Chr$(0)
    End If
 
' Speicherplatz für Dateieintrag (mit Pfadangabe) reservieren
    Dateiname_mit_Pfad = Space$(255) & Chr$(0)
 
' Speicherplatz für Dateieintrag (ohne Pfadangabe) reservieren
    Dateiname = Space$(255) & Chr$(0)
 
'Datenstruktur von DateiDialogStruktur festlegen
    DateiDialogStruktur.lStructSize = Len(DateiDialogStruktur)
    DateiDialogStruktur.hwndOwner = 0&
    'DateiDialogStruktur.hwndOwner = Application.hWndAccessApp
    DateiDialogStruktur.lpstrFilter = Dateityp
    DateiDialogStruktur.nFilterIndex = 1
    DateiDialogStruktur.lpstrFile = Dateiname_mit_Pfad
    DateiDialogStruktur.nMaxFile = Len(Dateiname_mit_Pfad)
    DateiDialogStruktur.lpstrFileTitle = Dateiname
    DateiDialogStruktur.nMaxFileTitle = Len(Dateiname)
    DateiDialogStruktur.lpstrInitialDir = Verzeichnis
    DateiDialogStruktur.lpstrTitle = Fenstertitel
    DateiDialogStruktur.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
    DateiDialogStruktur.nFileOffset = 0
    DateiDialogStruktur.nFileExtension = 0
    DateiDialogStruktur.lCustData = 0
    DateiDialogStruktur.lpfnHook = 0
    DateiDialogStruktur.lpTemplateName = ""
 
    Rueckwerte = GetSaveFileName(DateiDialogStruktur)
 
    If Rueckwerte <> 0 Then
        DateiSpeichern = Left(DateiDialogStruktur.lpstrFile, _
        InStr(DateiDialogStruktur.lpstrFile, Chr$(0)) - 1)
    End If
 
Exit_DateiSpeichern:
    Exit Function
 
Err_DateiSpeichern:
    MsgBox Err.Description
    Resume Exit_DateiSpeichern
 
End Function
Copyright 2000-2003 Microsys Kramer– Alle Rechte vorbehalten - Der Download von Tipps und Programmen von den Seiten www.access-paradies.de erfolgt auf eigene Gefahr. Microsys Kramer haftet nicht für Schäden, die aus der Installation oder der Nutzung von Tipps oder Software aus dem Download-Bereich erfolgen. Trotz aktueller Virenprüfung ist eine Haftung für Schäden und Beeinträchtigungen durch Computerviren ausgeschlossen. Schadenersatzansprüche, aus welchem Rechtsgrund auch immer, sind ausgeschlossen, wenn Microsys Kramer nicht Vorsatz oder grobe Fahrlässigkeit zu vertreten hat. Dies gilt auch für Ansprüche auf Ersatz von Folgeschäden wie Datenverlust.