title image


Smiley Re: Für PROFI : DateiDialog im Explorer-Style (DLL)
AnleitungErstelle eine neue Datenbank.Menü: Einfügen - Klassenmodul.Nenne dieses Klassenmodul CCommonDialog.Wenn Du Netscape verwendest, kannst Du folgenden Code über die Zwischenablage in Dein leeres Klassenmodul kopieren:Option Compare DatabaseOption Explicit''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' class module CCommonDialog, adds Windows CommonDialogs to Access.' Copyright (c) 1998 Thomas Prötzsch' ********************************************************************************' Usage:'' Sub xx()' Dim CDL As New CCommonDialog' Dim Dateiname as String ' short version:' Dateiname = CDL.ShowOpen ' or .ShowSave' if Dateiname = "" then exit sub ' canceled by user' .....'' without any variables:' CDL.ShowOpen ' or .ShowSave' if CDL.FileName = "" then exit sub ' canceled by user' .....'' detailed:'' With CDL' .DialogTitle = "Mein Titel"' .DefaultExt = "TXT" 'Default-extension, if nothing else was specified by user.' .InitDir = "d:\"' .Flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_READONLY' .Filter = "Textdateien (*.txt)|*.txt|MyFileType (*.my)|*.my"' .ShowOpen ' or .ShowSave' End With' End Sub''************************************************************************************ ' Public variables, can be accessed as Properties from outsidePublic FileName As String ' filenamePublic InitDir As String ' initial directoryPublic DefaultExt As String ' default extensionPublic DialogTitle As String ' dialog titlePublic Filter As String ' filter stringPublic FilterIndex As LongPublic Flags As Long ' flags Private Type TOpenFileName lStructSize As Long ' lenth of this data type OPENFILENAME hwndOwner As Long ' owning window of this dialog hInstance As Long ' not used lpstrFilter As String ' filterstring of display filters in dialog lpstrCustomFilter As String ' not used nMaxCustFilter As Long ' not used nFilterIndex As Long ' 1 for initial using the first filter, 2 for the second... lpstrFile As String ' return value containing user selection nMaxFile As Long ' lenght of lpstrFile lpstrFileTitle As String ' filename without Path (can also detemined in VB, therefore not userd here) nMaxFileTitle As Long ' not used lpstrInitialDir As String ' folder in which this Dialog should start browsing lpstrTitle As String ' titel of the dialog window Flags As Long ' several options, set by a combinaton of constants nFileOffset As Integer ' not used nFileExtension As Integer ' not used lpstrDefExt As String ' default extension, if no other extension has been entered by user lCustData As Long ' not used lpfnHook As Long ' Hook not used lpTemplateName As Long ' not usedEnd Type Private Declare Function API_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As TOpenFileName) As LongPrivate Declare Function API_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As TOpenFileName) As Long Public Function ShowOpen _( _ Optional sFileName, _ Optional sFilterString, _ Optional sInitDir, _ Optional sDialogTitle, _ Optional lFlags, _ Optional lFilterIndex, _ Optional sDefaultExt _) As String Dim OpenDlg As TOpenFileName  If Not IsMissing(sFileName) Then FileName = sFileName If Not IsMissing(sFilterString) Then Filter = sFilterString If Not IsMissing(sInitDir) Then InitDir = sInitDir If Not IsMissing(sDialogTitle) Then DialogTitle = sDialogTitle If Not IsMissing(lFlags) Then Flags = lFlags If Not IsMissing(lFilterIndex) Then FilterIndex = lFilterIndex If Not IsMissing(sDefaultExt) Then DefaultExt = sDefaultExt On Error GoTo Error_ShowOpen With OpenDlg .lStructSize = Len(OpenDlg) .hwndOwner = Application.hWndAccessApp .lpstrFilter = BuildFilter() .nFilterIndex = FilterIndex .lpstrFile = Left$(FileName & String$(API_STRING_LEN, vbNullChar), API_STRING_LEN) .nMaxFile = Len(.lpstrFile) - 1 .lpstrInitialDir = InitDir & vbNullChar If Len(DialogTitle) Then .lpstrTitle = DialogTitle & vbNullChar Else .lpstrTitle = "Datei öffnen" & vbNullChar End If If Flags = 0 Then .Flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_READONLY Else .Flags = Flags End If .lpstrDefExt = DefaultExt & vbNullChar  If API_GetOpenFileName(OpenDlg) 0 Then ' Aufruf erfolgreich ' man kann beides machen: ' Datei= fd.ShowOpen oder fd.ShowOpen : Datei=fd.FileName FileName = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1) ' restliche NUL-Werte abschneiden ShowOpen = FileName Else FileName = vbNullString ShowOpen = vbNullString End If End With Exit_ShowOpen: Exit Function Error_ShowOpen: MsgBox Err.Description, vbCritical, "Error: ShowOpen" Resume Exit_ShowOpenEnd Function Function ShowSave _( _ Optional sFileName, _ Optional sFilterString, _ Optional sInitDir, _ Optional sDialogTitle, _ Optional lFlags, _ Optional lFilterIndex, _ Optional sDefaultExt _) As String  Dim OpenDlg As TOpenFileName  If Not IsMissing(sFileName) Then FileName = sFileName If Not IsMissing(sFilterString) Then Filter = sFilterString If Not IsMissing(sInitDir) Then InitDir = sInitDir If Not IsMissing(sDialogTitle) Then DialogTitle = sDialogTitle If Not IsMissing(lFlags) Then Flags = lFlags If Not IsMissing(lFilterIndex) Then FilterIndex = lFilterIndex If Not IsMissing(sDefaultExt) Then DefaultExt = sDefaultExt On Error GoTo Error_ShowSave  With OpenDlg .lStructSize = Len(OpenDlg) .hwndOwner = Application.hWndAccessApp .lpstrFilter = BuildFilter() .nFilterIndex = FilterIndex .lpstrFile = Left$(FileName & String$(API_STRING_LEN, vbNullChar), API_STRING_LEN) .nMaxFile = Len(.lpstrFile) - 1 .lpstrInitialDir = InitDir & vbNullChar If Len(DialogTitle) Then .lpstrTitle = DialogTitle & vbNullChar Else .lpstrTitle = "Datei speichern unter" & vbNullChar End If If Flags = 0 Then .Flags = OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Else .Flags = Flags End If .lpstrDefExt = DefaultExt & vbNullChar  If API_GetSaveFileName(OpenDlg) 0 Then ' Successfull ' man kann beides machen: ' Datei= fd.ShowSave oder fd.ShowSave; Datei=fd.FileName FileName = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1) ' restliche NUL-Werte abschneiden ShowSave = FileName Else FileName = vbNullString ShowSave = vbNullString End If End With Exit_ShowSave: Exit Function Error_ShowSave: MsgBox Err.Description, vbCritical, "Error: ShowOpen" Resume Exit_ShowSaveEnd Function Private Sub Class_Initialize()On Error GoTo Err_Class_Init  FileName = vbNullString  ' Current Directory InitDir = CurDir$  ' no Default Extension DefaultExt = vbNullString  DialogTitle = vbNullString Filter = vbNullString FilterIndex = 0  Flags = 0 Exit_Class_Init: Exit Sub Err_Class_Init: MsgBox Err.Description, vbCritical Resume Exit_Class_InitEnd SubPrivate Function BuildFilter() As String Dim locFilter As String Dim i As Integer  locFilter = Filter If Len(locFilter) Then i = InStr(locFilter, "|") Do While i locFilter = Left$(locFilter, i - 1) & vbNullChar & Mid$(locFilter, i + 1) i = InStr(locFilter, "|") Loop Else locFilter = "Alle Dateien (*.*)" & vbNullChar & "*.*" End If BuildFilter = locFilter & vbNullChar & vbNullCharEnd FunctionHier noch die Konstanten, die bei mir in einem globalen Modul stehen:Public Const API_STRING_LEN = 512 Public Const OFN_READONLY = &H1Public Const OFN_OVERWRITEPROMPT = &H2Public Const OFN_HIDEREADONLY = &H4Public Const OFN_NOCHANGEDIR = &H8Public Const OFN_SHOWHELP = &H10Public Const OFN_ENABLEHOOK = &H20Public Const OFN_ENABLETEMPLATE = &H40Public Const OFN_ENABLETEMPLATEHANDLE = &H80Public Const OFN_NOVALIDATE = &H100Public Const OFN_ALLOWMULTISELECT = &H200Public Const OFN_EXTENSIONDIFFERENT = &H400Public Const OFN_PATHMUSTEXIST = &H800Public Const OFN_FILEMUSTEXIST = &H1000Public Const OFN_CREATEPROMPT = &H2000Public Const OFN_SHAREAWARE = &H4000Public Const OFN_NOREADONLYRETURN = &H8000Public Const OFN_NOTESTFILECREATE = &H10000Public Const OFN_NONETWORKBUTTON = &H20000Public Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modulesPublic Const OFN_EXPLORER = &H80000 ' new look commdlgPublic Const OFN_NODEREFERENCELINKS = &H100000Public Const OFN_LONGNAMES = &H200000 ' force long names for 3.x modulesDie Anwendung ist im Code beschrieben.Viel Erfolg!Thomas Prötzschcu
Thomas Prötzsch

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: