Rubrik: VBA Allgemein | VB-Versionen: VBA | 02.08.01 |
Datei-Dialog Mit diesen Funktionen haben Sie Zugriff auf die Datei-Öffnen- und Datei-Speichern-Dialoge. | ||
Autor: Microsys Kramer | Bewertung: | Views: 59.154 |
www.access-paradies.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
Mit diesen Funktionen haben Sie Zugriff auf die Datei-Öffnen- und Datei-Speichern-Dialoge.
Erstellen Sie ein neues Modul und fügen Sie nachfolgenden Code ein:
Option Explicit Type AP_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 AP_DateiDialogStruktur) As Long Declare Function GetSaveFileName Lib "comdlg32.dll" _ Alias "GetSaveFileNameA" ( _ DateiDialogStruktur As AP_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 AP_DateiDialogStruktur Function AP_DateiOeffnen(Verzeichnis As String, _ Fenstertitel As String) As String On Error GoTo Err_AP_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 AP_DateiOeffnen = Left(DateiDialogStruktur.lpstrFile, _ InStr(DateiDialogStruktur.lpstrFile, Chr$(0)) - 1) End If Exit_AP_DateiOeffnen: Exit Function Err_AP_DateiOeffnen: MsgBox Err.Description Resume Exit_AP_DateiOeffnen End Function ' Funktion: Datei speichern unter... Function AP_DateiSpeichern(Verzeichnis As String, _ Fenstertitel As String) As String On Error GoTo Err_AP_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 AP_DateiSpeichern = Left(DateiDialogStruktur.lpstrFile, _ InStr(DateiDialogStruktur.lpstrFile, Chr$(0)) - 1) End If Exit_AP_DateiSpeichern: Exit Function Err_AP_DateiSpeichern: MsgBox Err.Description Resume Exit_AP_DateiSpeichern End Function