Saya membayangkan Sampeyan mengklik button, yang nanti mengarah pada dialog sebagaimana di Ms Word/Ms Access/Excel membuka file baru. Bila benar. Buat modul file dialog seperti dibawah ini: 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 pries@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 (pries@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 = "mdb" & cnstNull & "*.mdb" 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 = "Pilih lokasi file database" & 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 'pries@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 Lalu, buat command button (misal Command8) dan textbox yang akan menampung lokasi folder. Lengkapi script seperti dibawah ini: Private Sub Command8_Click() On Error GoTo Error_command8_Click Const OFN_FILEMUSTEXIST = &H1000 Const OFN_PATHMUSTEXIST = &H800 Const OFN_HIDEREADONLY = &H4 Const OFN_READONLY = &H1 Const OFN_OVERWRITEPROMPT = &H2 Const OFN_ALLOWMULTISELECT = &H200 Const OFN_EXPLORER = &H80000 Dim fd As New FileDialog Dim i As Integer Dim FocusAufAuswahl As Boolean fd.ShowOpen If fd.FileName = "" Then Me!sasaran = "" Else Me!sasaran = fd.FileName End If Exit_command8_Click: Exit Sub Error_command8_Click: MsgBox Err.Description, , "Exit_command8_Click" Resume Exit_command8_Click End Sub Semoga bisa membantu dan memberi semangat. Hariyanto (Surabaya) --- On Fri, 13/1/12, Heri <nugroho185678@yahoo.co.id> wrote:
|
__._,_.___
SPAM IS PROHIBITED
MARKETPLACE
.
__,_._,___
No comments:
Post a Comment