Wie rufe ich ein Dateiauswahldialog auf?

[Robert Grund]

Hallo,

Kann mir wer ein Skript geben der funktioniert wie ich ein
Dateiauswahldialog öffne, eine Datei auswähle und diese
dann in einem Textfeld geschrieben wird.

Danke für jede Hilfe.

Servus,
Robert

[Mirco Wilhelm]

Hallo,

Kann mir wer ein Skript geben der funktioniert wie ich ein
Dateiauswahldialog öffne, eine Datei auswähle und diese
dann in einem Textfeld geschrieben wird.

z.B. so: (die braucht das MSOlang 1.0 Objekt in den Referenzen)

Public Function GetFileOrFolder( _
ByVal lngDialogType As MsoFileDialogType, _
Optional ByVal lngDialogView As
MsoFileDialogView, _
Optional ByVal strTitle As String, _
Optional ByVal strInitial As String, _
Optional ByVal bolAllowMultiple As Boolean,
_
Optional ByVal strFilterDesc As String, _
Optional ByVal strFilterExt As String) _
As String
On Error Resume Next

Dim objFD As FileDialog
Dim i As Integer

' only msoFileDialogOpen, msoFileDialogFilePicker and
' msoFileDialogFolderPicker are supported

Set objFD = Application.FileDialog(lngDialogType)

' set file filters
objFD.Filters.Clear

If strFilterDesc <> "" And strFilterExt <> "" Then
objFD.Filters.Add strFilterDesc, strFilterExt, 1
End If

Err
' set multiselect
objFD.AllowMultiSelect = bolAllowMultiple

' set caption
If strTitle > "" Then
objFD.Title = strTitle
End If

' set starting directory
If strInitial > "" Then
objFD.InitialFileName = strInitial
End If

Call objFD.Show

' return selected filenames seperated by semicolon
If objFD.SelectedItems.Count > 0 Then

For i = 1 To objFD.SelectedItems.Count
GetFileOrFolder = GetFileOrFolder &
Nz(CStr(objFD.SelectedItems(i)), "") & ";"
Next i

GetFileOrFolder = Left(GetFileOrFolder, Len(GetFileOrFolder) -
1)
End If

Set objFD = Nothing

End Function

[Johannes Karl]

Option Compare Database
Option Explicit

'Achtung: Bei Verwendung von /Decompile -
' /Decompile enthält einen Fehler, der bewirkt, daß danach manchmal
' ein Klassenmodul zwar noch so aussieht wie eines, aber keines mehr ist.
' Es hilft nur: Text des ehemaligen Klassenmoduls kopieren, ehemaliges
Klassenmodul
' löschen und ein neues Klassenmodul unter dem gleichen Namen erzeugen.

' Der Original README.TXT und History.txt von Karsten ist unten als
Kommentar angefügt

'This code was originally written by Karsten Pries.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'ShowFolder Code courtesy of Terry Kreft, please
'see original at http://www.mvps.org/access

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!
' Bugs/Wünsche/Vorschläge bitte an pr...@gmx.de
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!

' Wrapper für Win-API:
' "GetOpenFileNameA"
' "GetSaveFileNameA"
'
' Aufruf des CommonDialog von Windows zur Auswahl einer Datei
(öffnen/speichern)
' ohne Verwendung des OCX
'
'
***************************************************************************
*****
' Verwendung (noch mehr dazu im Demoformular):
'
' Sub xx()
' Dim fd As New FileDialog
' Dim Dateiname as String

' kurze Version:
' Dateiname = fd.ShowOpen ' oder .ShowSave
' if Dateiname = "" then exit sub ' Abbruch durch Benutzer
' .....
'
' ohne extra Variable:
' fd.ShowOpen ' oder .ShowSave
' if fd.FileName = "" then exit sub ' Abbruch durch Benutzer
' sonst z.B. Kill fd.FileName ' ausgewählte Datei löschen
' .....
'
' ausführlich:
'
' With fd
' .DialogTitle = "Mein Titel"
' .DefaultExt = "TXT" 'Standard-Endung wenn vom Benutzer
nix anderes angegeben
' .DefaultDir = "c:\"
' .Flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_READONLY
' .MultiSelect = True
' .Filter1Text = "Text-Dateien"
' .Filter1Suffix = "*.txt"
' .Filter2Text = "Ascii-Dateien"
' .Filter2Suffix = "*.asc"
' ... bis Filter5Text/Suffix ...
'
' .ShowOpen ' oder .ShowSave
'
' if fd.FileName = "" then exit sub ' Abbruch durch Benutzer
' DateiName = fd.FileName
' End With
' End Sub
'
'**************************************************************************
**********
'
' Bemerkung: Die Property .Filter ist für die Abwärtskompatibilität und für
Leute,
' die wissen was sie tun. Alle anderen sollen FilterXText/Suffix
benutzen.
' Näheres im Code zu .Filter.
'**************************************************************************
**********
'
' Karsten Pries (pr...@gmx.de)

' Konstanten
Private Const LEN_FILENAME_NORMAL As Integer = 512 'Ist der
zurückgegebene Name zu lang,
Private Const LEN_FILENAME_MULTISELECT As Long = 2000 'gibts beim
API-Aufruf einen Fehler und .FileName liefert ""

Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXPLORER = &H80000

Private Const BIF_RETURNONLYFSDIRS = &H1

' interne Variablen, über Properties gesetzt/gelesen:
Private strDialogTitle As String ' Dialogtitel
Private strFilter As String ' Filter kann man sowohl wie gehabt
definieren als
' auch über die folgenden Paare
Text/Suffix
Private lngFlags As Long ' Flags
Private strDefaultExt As String ' Standard-Endung
Private strInitDir As String ' Start-Verzeichnis
Private blnMultiSelect As Boolean ' Multiselect erlauben Ja/Nein
Private intFileCount As Integer ' Anzahl Dateien bei MultiSelect

' optionale Filterparameter, ersparen
die Mühe des Zusammenbaus
Private strFilterText(5) As String ' z.B. "Text-Dateien"
Private strFilterSuffix(5) As String ' z.B. "*.txt"
Private lngHWnd As Long ' Handle Window

' bei Multiselect kompatibel zum OCX, d.h. bei .Filename wird String der
' Form "Pfad & vbnullchar & Datei1 & vbnullchar & Datei2 & ..."
zurückgegeben
Private blnKompatibel As Boolean

' interne Variablen, von Funktionen benutzt
Private strDateiName As String ' zurückgegebener Dateiname
Private cnstNull As String * 1 ' NULL-String
Private strDefaultFileNameSave As String ' Default merken, falls bei
Multiselect
' Stringlänge erhöht werden muß
Private intLenFileName As Integer ' max. Länge des zurückgegebenen
Strings, entweder LEN_FILENAME_NORMAL
' oder LEN_FILENAME_MULTISELECT. Ist
der zurückgegebene Name zu lang,
' gibts beim API-Aufruf einen Fehler
und .FileName liefert ""

' Typen
Private Type TOpenFileName
lStructSize As Long ' Länge des Datentyps OPENFILENAME
hwndOwner As Long ' Fenster, unter dem Dialog erscheint
hInstance As Long ' nicht verwendet
lpstrFilter As String ' Zeichenkette von Anzeigenfiltern im
Dialog
lpstrCustomFilter As String ' nicht verwendet
nMaxCustFilter As Long ' nicht verwendet
nFilterIndex As Long ' 1 zum Benutzen des ersten Filters, 2
zum zweiten usw.
lpstrFile As String ' String, der ausgewählte Datei bekommt
nMaxFile As Long ' Länge von lpstrFile
lpstrFileTitle As String ' Dateiname ohne Pfad (kann auch mit VBA
ermittelt werden, also weglassen)
nMaxFileTitle As Long ' nicht verwendet
lpstrInitialDir As String ' Ordner, in dem Dialog sich zuerst
befinden soll
lpstrTitle As String ' Titel des eigentlichen Dialogfensters
flags As Long ' verschiedene Optionen, die durch
Konstanten eingestellt werden
nFileOffset As Integer ' nicht verwendet
nFileExtension As Integer ' nicht verwendet
lpstrDefExt As String ' Erweiterung, die genommen wird, wenn
keine eingegeben wurde
lCustData As Long ' nicht verwendet
lpfnHook As Long ' nicht verwendet
lpTemplateName As Long ' nicht verwendet
End Type

Private Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function APT_GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As TOpenFileName) As Long
Private Declare Function APT_GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As TOpenFileName) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias
"SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As
Long

Property Let hWnd(lngAktHWnd As Long)
lngHWnd = lngAktHWnd
End Property

Private Function CountFiles(strSelection As String) As Integer
On Error GoTo Error_CountFiles
' zählen der selektierten Dateien

Dim idx As Integer, idxold As Integer
Dim count As Integer

idx = InStr(1, strSelection, cnstNull)

Do Until idx = idxold
idxold = idx + 1
count = count + 1
idx = InStr(idxold, strSelection, cnstNull)
Loop

CountFiles = count

Exit_CountFiles:
Exit Function
Error_CountFiles:
MsgBox Err.Description, , "Exit_CountFiles"
Resume Exit_CountFiles
End Function

Property Let DefaultDir(strAktDefaultDir As String)
strInitDir = strAktDefaultDir & cnstNull
End Property

Property Get FileCount() As Integer
' Anzahl ausgewählter Dateien (she. auch .MultiSelect)
FileCount = intFileCount
End Property

Property Get GetNextFile() As String
GetNextFile = ParseAuswahl()
End Property

Property Let InitDir(strAktDefaultDir As String)
Me.DefaultDir = strAktDefaultDir
End Property

Property Let DefaultFileName(strAktDefaultFileName As String)
strDefaultFileNameSave = strAktDefaultFileName
End Property

Private Function BuildFilter() As String
' bastelt bei Aufruf Open/Save aus den .FilterXText/Suffix und .Filter
' einen gültigen Filterstring
On Error GoTo Error_BuildFilter

Dim myFilter As String
Dim i As Integer

' wenn .FilterXText/Suffix gesetzt dann String zusammenbauen
For i = 1 To UBound(strFilterText)
If strFilterText(i) <> "" And strFilterSuffix(i) <> "" Then
myFilter = myFilter & strFilterText(i) & cnstNull &
strFilterSuffix(i) & cnstNull
End If
Next

If strFilter <> "" Then ' .Filter wurde manuell gesetzt
' cut trailing nulls
Do While Right(strFilter, 1) = cnstNull
strFilter = Left(strFilter, Len(strFilter) - 1)
Loop

myFilter = strFilter & cnstNull & myFilter
End If

If myFilter = "" Then myFilter = "Alle Dateien" & cnstNull & "*.*"

myFilter = myFilter & cnstNull & cnstNull

BuildFilter = myFilter

Exit_BuildFilter:
Exit Function
Error_BuildFilter:
MsgBox Err.Description, , "Exit_BuildFilter"
Resume Exit_BuildFilter
End Function

Private Sub CheckFlags(Intention As String)

' wenn die Flags schon manuell gesetzt wurden: nix tun,
' außer wenn explizit Multiselect gewollt wird
If lngFlags <> 0 Then
If blnMultiSelect Then lngFlags = lngFlags Or OFN_ALLOWMULTISELECT
Or OFN_EXPLORER
Exit Sub
End If

' sonst abhängig von Intention:
Select Case Intention:
Case "Open":
lngFlags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or
OFN_HIDEREADONLY
If blnMultiSelect Then lngFlags = lngFlags Or OFN_ALLOWMULTISELECT
Or OFN_EXPLORER
Case "Save":
lngFlags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or
OFN_OVERWRITEPROMPT
Case Else:
MsgBox "Unbekannte Intention: " & Intention, vbOKOnly +
vbCritical, "CheckFlags"
End Select
End Sub

Property Let DefaultExt(strAktDefaultExt As String)
strDefaultExt = strAktDefaultExt & cnstNull
End Property

Property Let DialogTitle(Title As String)
strDialogTitle = Title & cnstNull
End Property

Property Get FileName() As String
FileName = strDateiName
End Property

Property Let Filter(aktFilter As String)
' wer dieses Property benutzt muß wissen was er tut, siehe für sichere
Filterstrings
' die Properties FilterXText/FilterXSuffix

' Korrekte Filterstrings haben z.B. die Form
' "Alle Dateien" & cnstNull & "*.*" & cnstNull & cnstNull

' Korrekte Filter enden mit zweimal cnstnull
If Len(aktFilter) >= 2 And Right(aktFilter, 2) = cnstNull & cnstNull
Then
strFilter = aktFilter
Else
strFilter = aktFilter & cnstNull & cnstNull
End If

End Property

Property Let Filter1Text(FilterText As String)
strFilterText(1) = FilterText
End Property
Property Let Filter2Text(FilterText As String)
strFilterText(2) = FilterText
End Property
Property Let Filter3Text(FilterText As String)
strFilterText(3) = FilterText
End Property

Property Let Filter4Text(FilterText As String)
strFilterText(4) = FilterText
End Property

Property Let Filter5Text(FilterText As String)
strFilterText(5) = FilterText
End Property

Property Let Filter1Suffix(FilterSuffix As String)
strFilterSuffix(1) = FilterSuffix
End Property

Property Let Filter2Suffix(FilterSuffix As String)
strFilterSuffix(2) = FilterSuffix
End Property
Property Let Filter3Suffix(FilterSuffix As String)
strFilterSuffix(3) = FilterSuffix
End Property
Property Let Filter4Suffix(FilterSuffix As String)
strFilterSuffix(4) = FilterSuffix
End Property
Property Let Filter5Suffix(FilterSuffix As String)
strFilterSuffix(5) = FilterSuffix
End Property

Property Let flags(lngAktFlags As Long)
lngFlags = lngAktFlags
End Property

Property Let MultiSelect(blnAktMultiSelect As Boolean)
blnMultiSelect = blnAktMultiSelect
intLenFileName = LEN_FILENAME_MULTISELECT
End Property

Property Let MultiSelectOCXCompatible(blnAktKompatibel As Boolean)
' wenn True dann Rückgabe der selektierten Dateien bei .FileName in der
Form
' "Pfad & vbnullchar & Datei1 & vbnullchar & Datei2 & ..." und
' nicht über .GetNextFile, kompatibel zum OCX

blnKompatibel = blnAktKompatibel

' vorsichtshalber auch gleich noch .MultiSelect auf True setzen
If blnAktKompatibel Then
blnMultiSelect = True
intLenFileName = LEN_FILENAME_MULTISELECT
End If

End Property

Private Function ParseAuswahl(Optional strAuswahl As String = "", Optional
blnInitial As Boolean = False)
On Error GoTo Error_ParseAuswahl
' wird nur für Multiselect verwendet. Mit blnInitial=True werden die
' statischen Variablen initialisiert. Beim ersten Aufruf (blnInitial=True)
' wird der Name der ersten Datei zurückgeliefert, bei jedem folgenden
' Aufruf ohne Argumente der Name der nächsten. Der Initial-Aufruf erfolgt
' aus .ShowOpen, weitere Aufrufe von außen über .GetNextFile, bis ein
Leerstring
' ("") zurückgeliefert wird.
'
' strAuswahl hat folgende Form (nur bei Initial):
' mehrere Dateien selektiert: voller Pfad & chr(0) & Datei1 & chr(0) &
datei2 & ....
' nur eine Datei selektiert: Voller Dateiname inkl. Pfad & chr(0) & chr(0)
& ...

Static strPfadName As String
Static strDateien As String
Dim Dummy As String
Dim retval As String
Dim idx As Integer

If blnInitial Then
strDateien = strAuswahl

idx = InStr(strDateien, cnstNull) ' erste 0

If Asc(Mid(strDateien, idx + 1, 1)) = 0 Then
' nach der ersten 0 kommt gleich noch eine weitere, d.h. trotz
Multiselect
' wurde nur eine Datei ausgewählt
retval = Left$(strDateien, idx - 1)
intFileCount = 1

Else ' als erstes kommt der Pfadname
strPfadName = Left$(strDateien, idx - 1)
' bei c:\ wird der Backslash mitgeliefert, bei c:\windows
nicht. Alle lieben Microsoft.
If Right$(strPfadName, 1) = "\" Then strPfadName =
Left$(strPfadName, Len(strPfadName) - 1)

strDateien = Mid$(strDateien, idx + 1)

intFileCount = CountFiles(strDateien)

idx = InStr(strDateien, cnstNull)
Dummy = Left$(strDateien, idx - 1)
strDateien = Mid$(strDateien, idx + 1)

retval = strPfadName & "\" & Dummy

End If


Else ' Folgeaufruf

idx = InStr(strDateien, cnstNull)
If idx > 0 Then
Dummy = Left$(strDateien, idx - 1)
strDateien = Mid$(strDateien, idx + 1)
retval = strPfadName & "\" & Dummy
Else
retval = ""
End If
End If

ParseAuswahl = retval

Exit_ParseAuswahl:
Exit Function
Error_ParseAuswahl:
MsgBox Err.Description, , "Exit_ParseAuswahl"
Resume Exit_ParseAuswahl
End Function

'This code was originally written by Terry Kreft.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code courtesy of
'Terry Kreft
Function ShowFolder() As String
On Error GoTo Error_ShowFolder

Dim X As Long, bi As BROWSEINFO, dwIList As Long
Dim szPath As String

With bi
If lngHWnd = 0 Then
.hOwner = Application.hWndAccessApp
Else
.hOwner = lngHWnd
End If
.lpszTitle = strDialogTitle
.ulFlags = BIF_RETURNONLYFSDIRS
End With

dwIList = SHBrowseForFolder(bi)
szPath = Space$(512)
X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

If X Then
strDateiName = Left$(szPath, InStr(szPath, cnstNull) - 1) '
restliche NUL-Werte abschneiden
ShowFolder = strDateiName
Else
strDateiName = ""
ShowFolder = ""
End If

Exit_ShowFolder:
Exit Function
Error_ShowFolder:
MsgBox Err.number & ": " & Err.Description, , "ShowFolder"
Resume Exit_ShowFolder
End Function

Function ShowOpen() As String
On Error GoTo Error_ShowOpen

Dim myFilter As String
Dim OpenDlg As TOpenFileName

myFilter = BuildFilter()
Call CheckFlags("Open")

If strDialogTitle = "" Then
strDialogTitle = "Datei öffnen" & cnstNull
End If

' String für Default-Dateinamen setzen, Länge kann variieren
(Normal/Multiselect), deswegen hier
strDateiName = strDefaultFileNameSave & String$(intLenFileName -
Len(strDefaultFileNameSave), 0)

With OpenDlg
.lStructSize = Len(OpenDlg)
If lngHWnd = 0 Then
.hwndOwner = Application.hWndAccessApp
Else
.hwndOwner = lngHWnd
End If
.lpstrFilter = myFilter
.nFilterIndex = 1
.lpstrFile = strDateiName
.nMaxFile = Len(strDateiName)
.lpstrInitialDir = strInitDir
.lpstrTitle = strDialogTitle
.flags = lngFlags
.lpstrDefExt = strDefaultExt

If APT_GetOpenFileName(OpenDlg) <> 0 Then ' Aufruf erfolgreich

If blnMultiSelect Then

If Not blnKompatibel Then
strDateiName = ParseAuswahl(.lpstrFile, True)
Else ' OCX-kompatibel
strDateiName = Left$(.lpstrFile, InStr(.lpstrFile, cnstNull
& cnstNull) - 1) ' restliche NUL-Werte abschneiden
End If
Else
intFileCount = 1
strDateiName = Left$(.lpstrFile, InStr(.lpstrFile, cnstNull) -
1) ' restliche NUL-Werte abschneiden
End If

' man kann beides machen:
' Datei= fd.ShowOpen oder fd.ShowOpen : Datei=fd.FileName
ShowOpen = strDateiName
Else
strDateiName = ""
ShowOpen = ""
intFileCount = 0
End If
End With

Exit_ShowOpen:
Exit Function
Error_ShowOpen:
MsgBox Err.Description, , "Exit_ShowOpen"
Resume Exit_ShowOpen
End Function

Function ShowSave() As String
On Error GoTo Error_ShowSave

Dim myFilter As String
Dim OpenDlg As TOpenFileName

myFilter = BuildFilter()
Call CheckFlags("Save")

If strDialogTitle = "" Then
strDialogTitle = "Datei speichern unter" & cnstNull
End If

' String für Default-Dateinamen setzen, Länge kann variieren
(Normal/Multiselect), deswegen hier
strDateiName = strDefaultFileNameSave & String$(intLenFileName -
Len(strDefaultFileNameSave), 0)

With OpenDlg
.lStructSize = Len(OpenDlg)
If lngHWnd = 0 Then
.hwndOwner = Application.hWndAccessApp
Else
.hwndOwner = lngHWnd
End If
.lpstrFilter = myFilter
.nFilterIndex = 1
.lpstrFile = strDateiName
.nMaxFile = Len(strDateiName)
.lpstrInitialDir = strInitDir
.lpstrTitle = strDialogTitle
.flags = lngFlags
.lpstrDefExt = strDefaultExt

If APT_GetSaveFileName(OpenDlg) <> 0 Then ' Aufruf erfolgreich
' man kann beides machen:
' Datei= fd.ShowSave oder fd.ShowSave; Datei=fd.FileName
strDateiName = Left$(.lpstrFile, InStr(.lpstrFile, cnstNull) - 1)
' restliche NUL-Werte abschneiden
ShowSave = strDateiName
Else
strDateiName = ""
ShowSave = ""
End If
End With

Exit_ShowSave:
Exit Function
Error_ShowSave:
MsgBox Err.Description, , "Exit_ShowSave"
Resume Exit_ShowSave
End Function

Private Sub Class_Initialize()
On Error GoTo Error_Class_Initialize

' Null-String initialisieren
cnstNull = Chr$(0)

' der String sollte lang genug für einen Win-95 Pfad sein,
' für Multiselect wird das in .MultiSelect auf LEN_FILENAME_MULTISELECT
erhöht
intLenFileName = LEN_FILENAME_NORMAL
strDateiName = String$(LEN_FILENAME_NORMAL, 0)

strDialogTitle = "" ' erstmal leer, wird in .ShowOpen/.ShowSave auf
Default gesetzt
strFilter = "" ' erstmal leer, wird in BuildFilter() gebaut

' erstmal keine Default-Flags (wird in ShowOpen/ShowSave gesetzt)
lngFlags = 0

' keine Default-Erweiterung
strDefaultExt = cnstNull

' aktuelles Verzeichnis
strInitDir = CurDir$ & cnstNull

Exit_Class_Initialize:
Exit Sub
Error_Class_Initialize:
MsgBox Err.Description, , "Exit_Class_Initialize"
Resume Exit_Class_Initialize
End Sub

'################### Readme.txt #####################################

'Readme.txt für comdlgdemo.mdb
'Version 1.3 für Microsoft Access 97, 09/99
'
'CommonDialog -Demo
'------------------
'
'Diese Datei enthält ein Klassenmodul zum Aufruf des
'Standard-Windows Datei öffnen/speichern Dialogs.
'
'Damit werden die API-Funktionen
' GetOpenFileNameA
' GetSaveFileNameA
'gekapselt und programmiererfreundlich verpackt.
'
'Die gleiche Funktion erhält man auch mit dem OCX
'von Microsoft (comdlg32.ocx), das kann zusätzlich
'Farben-, Schrift- und Druckereinstellungen (nein,
'nicht den Drucker wechseln). Stürzt aber öfter
'ab, ist groß, braucht einen Verweis, ... naja.
'Jedenfalls habe ich die Eigenschafts- und Methoden-
'namen von da geklaut, so daß man das Ding mit meinem
'Klassenmodul problemlos austauschen kann.
'
'
'Kurze Bemerkung zu Klassenmodulen:
' Obwohl Klassenmodule wie ganz normale Module
' in der Modul-Liste erscheinen, haben sie eine
' andere Funktion.
'
' 1.) Sie besitzen eigene Methoden und Eigenschaften
' und können im Code wie ganz normale Objekte
' (z.B. Steuerelemente) angesprochen werden.
'
' Dabei ist der NAME (!!) des Klassenmoduls der
' Typ des Objekts. Beispiel: Das Klassenmodul in
' dieser Demo heißt 'FileDialog', mittels
'
' Dim fd As New FileDialog
'
' wird ein neues Objekt dieser Klasse erzeugt.
'
' Wenn jetzt jemand auf die Idee kommt und das
' Klassenmodul in 'HumphreyBogart' umbenennt,
' muß der Code in
' Dim xy As HumphreyBogart
' geändert werden. Dann hätte HumphreyBogart
' die Eigenschaften .DefaultFileName, DialogTitle, ...
' Naja, lassen wir das.
'
' 2.) Weil es eben keine normalen Module sind,
' funktioniert bei der Übernahme in eigene Anwendungen
' ein einfaches Cut'n Paste nicht. Auch speichern
' als Text und Einfügen in ein normales Modul funktioniert
' nicht, man bekommt die Fehlermeldung:
' "Benutzerdefinierter Typ nicht definiert"
'
' Die Übernahme in eigene Anwendungen funktioniert auf
' zwei Arten:
' a) Importieren aus dieser Demo (Datei->Externe Daten->
' Importieren)
' b) Erstellen eines neuen Klassenmoduls (Einfügen->
' Klassenmodul) und pasten des Codes. Hierbei ist
' das Benennungsproblem von oben zu beachten.
'
' Tip: Klassenmodule haben auch ein anderes Icon, daran
' kann man ganz gut sehen, ob man es richtig importiert
' hat.
'
'Die Demo enthält ein Formular, in dem die wichtigsten
'Funktionen dargestellt sind. Anschauen und ausprobieren
'sollte die meisten Fragen klären.
'
'Funktionsbeispiele stehen als Kommentare im Klassenmodul
'und im Demo-Formular.
'
'Updates könnte es unter
'
' www.cube.net/~pries/access.html
'
'geben.
'
'Fragen bitte in die Newsgroup
'
' de.comp.datenbanken.ms -Access
'
'(preferred, viele dort kennen das Modul) oder direkt an mich.
'
'09/99 K.Pries
'pr...@gmx.de

'################### Histrory.txt #####################################

'noch zu tun / möglicherweise unlösbar:
'
' um bei Verwendung des .DefaultFileName NUR die eine vorgegebene Datei
' angezeigt zu bekommen, muß man mindestens ein Wildcard verwenden
' (fd.DefaultFileName = "msaccess.exe*"), ansonsten werden alle angezeigt.
Keine
' Ahnung woran es liegt.
'
'--------------------------------------------------------------------------
------
'--------------------------------------------------------------------------
------
'09/1999
'Version 1.3:
'
' neue Funktion .ShowFolder:
' Auswahl eines Directories
'
' Bug bei mehrfachem Aufruf direkt nacheinander (ohne Neuerzeugung des
fd-Objektes
' mittels 'Dim fd as New FileDialog') beseitigt. Wenn beim zweiten Aufruf
der
' zurückgegebene Dateiname länger war als der vorher ausgewählte wurde
wegen
' eines Fehlers bei der Initialisierung ein leerer String ("")
zurückgegeben.
'
'
' neues Property .hWnd
' Damit ist bei Formularen, die mittels acDialog geöffnet wurden (und
nur da,
' warum auch immer), ein Ausrichten des Dialogs auf das Formular möglich
' und der Dialog klebt nicht mehr an der linken oberen Ecke des
Access-Fensters.
' Bei nicht acDialog-Formularen ist die Verwendung unschädlich,
allerdings auch
' unnütz.
'Verwendung: fd.hWnd = Me.hWnd
'
'
' Kreuzchen für 'Mit Schreibschutz öffnen' beim Öffnen entfernt. Sinn hat
es
' sowieso keinen, wie man die Datei öffnet bleibt jedem selbst überlassen.
Wer es
' wiederhaben möchte möge in CheckFlags() bei Case "Open" OFN_HIDEREADONLY
durch
' OFN_READONLY ersetzen (dann ist das Kreuzchen da und nicht angekreuzt)
oder
' OFN_HIDEREADONLY ganz entfernen (dann ist das Kreuzchen da und
angekreuzt).
'
'
' Bei Verwendung von fd.MultiSelectOCXCompatible=True wird automatisch
' auch fd.MultiSelect = True gesetzt (Fehlervermeidung)
'
'
'
'
'--------------------------------------------------------------------------
------
'--------------------------------------------------------------------------
------
'26.3.1999
'Version 1.2:
'
' neues Property .MultiSelect
' zur Selektion mehrerer Dateinamen auf einmal, Rückgabe der Namen
entweder mit
'
' .MultiSelectOCXCompatible = True
'
' wie im OCX (in der Form "Pfad & vbnullchar & Datei1 & vbnullchar &
Datei2 & ..."
' oder mit
'
' .MultiSelectOCXCompatible=False (Voreinstellung)
'
' über .GetNextFile
'
' neues Property .MultiSelectOCXCompatible s.o.
'
' neues Property .GetNextFile s.o.
'
' neues Property .FileCount
' Anzahl der bei MultiSelect ausgewählten Dateien, gut als
Schleifenbegrenzer
' in Zusammenhang mit .GetNextFile (s.o). Terminierung aber auch mittels
' GetNextFile="".
'
' Anzahl der möglichen Zeichen für zurückgegebenen String erhöht:
' LEN_FILENAME_MULTISELECT = 2000
'!! ACHTUNG: Bei Auswahl sehr vieler Dateien diesen Wert im Klassenmodul
erhöhen !!
'
' LEN_FILENAME_NORMAL = 512
'
'--------------------------------------------------------------------------
------
'--------------------------------------------------------------------------
------
'25.1.1999
'Version 1.1:
'
' neues Property .DefaultFileName
' zur Vorgabe eines Dateinamens
'
' neues Property .DefaultDir
' wie .InitDir, nur zur Vereinheitlichung der Namen eingeführt.
' (InitDir ist der Name im OCX)
'
'--------------------------------------------------------------------------
------
'--------------------------------------------------------------------------
------
'1.11.1997
'Version 1#: ursprüngliches Release

--
Access-FAQ: www.donkarl.com

[Gunter Avenius]

Hallo Robert,

Robert Grund schrieb folgendes:

> Kann mir wer ein Skript geben der funktioniert wie ich ein
> Dateiauswahldialog öffne, eine Datei auswähle und diese
> dann in einem Textfeld geschrieben wird.

Lade dir meine Toolssammlung für A00/AX/A2003 herunter diese enthält u.a.
einen Assistenten welcher Dir den benötigten Code incl. Aufruf in Deine DB
kopiert.

--
Gruß
Gunter
_________________________________________________
Access FAQ: http://www.donkarl.com
home: http://www.avenius.com

[Klaus Oberdalhoff [MVP]]

Hi,

> Kann mir wer ein Skript geben der funktioniert wie ich ein
> Dateiauswahldialog öffne, eine Datei auswähle und diese
> dann in einem Textfeld geschrieben wird.

in der KnowHow.mdb (www.freeaccess.de) ist ein komplettes Beispiel
("frmTestFileDialog Vers 13") von Karsten drinnen. Johannes hat ja schon einen
Auszug daraus gepostet.

--
mfg

Klaus Oberdalhoff(Access MVP) KO...@gmx.de
Info unter: http://www.freeaccess.de/KlausOberdalhoff.asp

Ich beantworte keine NG-Fragen und -Nachfragen per Mail!
Newbie-Info: http://www.doerbandt.de/Access/Newbie.htm
KnowHow-mdb: http://www.freeaccess.de