Dateidialog (Öffnen & Speichern) Für Access 97/2000/XP [Archiv]

Günther Kramer

28.12.2002, 10:40

<img src="images/codearchiv/dateidialog.gif" border=0> Fügen Sie den folgenden Code in ein Modul (neu oder vorhanden) ein.

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre>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</pre></div>

Zum Öffnen verwenden Sie innerhalb Ihres Formulars den folgenden Code:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre>Dim Path As String
 
Path = DateiOeffnen("C:\Eigene Dateien", "Datei öffnen")
MsgBox Path</pre></div>

Zum Speichern einer Datei verwenden Sie den folgenden Code:

<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre>Dim Path As String
 
Path = DateiSpeichern("C:\Eigene Dateien", "Datei speichern")
MsgBox Path</pre></div>

Sascha Trowitzsch

06.02.2005, 18:04

Ab Access2000 kann man sich die (lange) API-Lösung sparen und zum Öffnen einer Datei der undokumentierten Access-Klasse Wizhook bedienen:
<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre>'Ab A2000:
Function OpenFileName(Optional StartDir As String, _
Optional sTitle As String = "Datei auswählen:", _
Optional sFilter As String = "Access-DB (*.mdb)|Alle Dateien (*.*)") As String
Static sDir As String
 
WizHook.Key = 51488399
If Len(StartDir) = 0 Then
If Len(sDir) = 0 Then
StartDir = CurrentProject.Path
Else
StartDir = sDir
End If
End If
Call WizHook.GetFileName(Application.hWndAccessApp, _
"Microsoft Access", sTitle, _
"Öffnen", OpenFileName, _
StartDir, sFilter, _
0&, 0&, &H40, True)
If Len(OpenFileName) > 0 Then
sDir = Left(OpenFileName, InStrRev(OpenFileName, "\", , vbTextCompare))
End If
End Function<hr></pre></div>

Der Vollständigkeit halber hier noch ein analoger Code für den ab AXP eingebauten FileDialog - obwohl es mit dem WizHook-Code wegen des einfachen Filter-Strings einfacher geht:
<div><link href="http://www.ms-office-forum.net/forum/externals/codeconv.css" rel="stylesheet"><pre>'AXP ff.:
Public Function OpenFileNameAX(Optional StartDir As String, _
Optional sTitle As String = "Datei auswählen:", _
Optional sFilter As String = "Access-Datenbank (*.mdb)|Alle Dateien (*.*)") As String
Dim clsDialog As Office.FileDialog
Dim vFilter As Variant, i As Long
Dim strExt As String, sDescr As String
 
Set clsDialog = Application.FileDialog(msoFileDialogFilePicker)
With clsDialog
.Title = sTitle
.InitialFileName = StartDir
.AllowMultiSelect = False
.ButtonName = "OK"
.InitialView = msoFileDialogViewList
If sFilter <> "" Then
.Filters.Clear
vFilter = Split(sFilter, "|")
For i = 0 To UBound(vFilter)
strExt = Trim(Mid(vFilter(i), InStrRev(vFilter(i), "(") + 1))
If Right(strExt, 1) = ")" Then strExt = Trim(Left(strExt, Len(strExt) - 1))
sDescr = Trim(Left(vFilter(i), InStrRev(vFilter(i), "(") - 1))
.Filters.Add sDescr, strExt
Next i
Else
.Filters.Add "Access-Datenbank", "*.mdb;*.mde"
End If
If .Show Then OpenFileNameAX = .SelectedItems(1)
End With
 
End Function<hr></pre></div>

Ciao, Sascha

SkipperUwe

16.11.2006, 12:26

Hallo Sascha!

Dein Vorschlag gefällt mir, jedoch benötige ich statt msoFileDialogFilePicker die Option msoFileDialogSaveAs.
Wird dann
Set clsDialog = Application.FileDialog(msoFileDialogSaveAs)
ausgeführt, so gibt Access das folgenden Fehlerfenster aus:

Microsoft Visual Basic
Laufzeitfehler '445':
Objekt unterstützt diese Aktion nicht

Für einen Tip wäre ich dankbar

Linus1971

19.11.2006, 20:42

Hallo,

Du solltest Deine Frage vielleicht im Access Forum (http://ms-office-forum.de/forum/forumdisplay.php?f=60) stellen und dort Bezug auf diesen Thread hier nehmen. Im Forum wird Deine Frage vielleicht noch schneller beantwortet.

Ausserdem sollten hier im Code-Archiv keine Fragen gestellt werden.