Browsen im Access

Hallo, ja das geht.

Aufruf in Form:
Code:
Dim Datei As String

Datei = open32("JPG - Datei (*.jpg)" & vbNullChar & "*.jpg" & vbNullChar & _
           "Bitmap (*.bmp)" & vbNullChar & "*.bmp" & vbNullChar & _
           "TIF - Datei (*.tif)" & vbNullChar & "*.tif" & vbNullChar & _
           "GIF - Datei (*.gif)" & vbNullChar & "*.gif")

In Modul:
Code:
Option Compare Database

Type OPENFILENAME32
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

Public Const OFN_READONLY = &H1
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_SHOWHELP = &H10
Public Const OFN_ENABLEHOOK = &H20
Public Const OFN_ENABLETEMPLATE = &H40
Public Const OFN_ENABLETEMPLATEHANDLE = &H80
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_SHAREAWARE = &H4000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOTESTFILECREATE = &H10000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOLONGNAMES = &H40000 ' force no long names for 4.x modules
Public Const OFN_EXPLORER = &H80000 ' new look commdlg
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_LONGNAMES = &H200000 ' force long names for 3.x modules

Public Const OFN_SHAREFALLTHROUGH = 2
Public Const OFN_SHARENOWARN = 1
Public Const OFN_SHAREWARN = 0

' Error-Konstanten
Public Const CDERR_DIALOGFAILURE = &HFFFF

Public Const CDERR_GENERALCODES = &H0
Public Const CDERR_STRUCTSIZE = &H1
Public Const CDERR_INITIALIZATION = &H2
Public Const CDERR_NOTEMPLATE = &H3
Public Const CDERR_NOHINSTANCE = &H4
Public Const CDERR_LOADSTRFAILURE = &H5
Public Const CDERR_FINDRESFAILURE = &H6
Public Const CDERR_LOADRESFAILURE = &H7
Public Const CDERR_LOCKRESFAILURE = &H8
Public Const CDERR_MEMALLOCFAILURE = &H9
Public Const CDERR_MEMLOCKFAILURE = &HA
Public Const CDERR_NOHOOK = &HB
Public Const CDERR_REGISTERMSGFAIL = &HC

Declare Function GetOpenFileNameA Lib "comdlg32.dll" (pOpenfilename As OPENFILENAME32) As Long

Declare Function GetDesktopWindow Lib "user32.dll" () As Long


Function open32(szFilter$)
Dim O As OPENFILENAME32
Dim szFile$
Dim wSize As Long
Dim Result
Dim File$
Dim Memhandle As Long, hwnd As Long

szFile$ = String$(128, 0)

O.lStructSize = Len(O)
O.hwndowner = GetDesktopWindow()
O.Flags = OFN_FILEMUSTEXIST Or OFN_HIDEREADONLY Or OFN_PATHMUSTEXIST 'Or OFN_SHOWHELP 'Or OFN_ALLOWMULTISELECT
O.nFilterIndex = 1
O.nMaxFile = Len(szFile$)
O.lpstrFile = szFile$
O.lpstrFilter = szFilter$ & vbNullChar & "Alle Dateien (*.*)" & vbNullChar & "*.*" & vbNullChar & vbNullChar


Result = GetOpenFileNameA(O)
If Result = 0 Then Exit Function

File$ = Left$(O.lpstrFile, InStr(O.lpstrFile, Chr$(0)) - 1)

open32 = File$

End Function
 
Zurück