Option Explicit
Type ACL_OPENFILENAME
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 API_DateiOeffnen Lib „comdlg32.dll“ Alias _
„GetOpenFileNameA“ (pOpenfilename As ACL_OPENFILENAME) As Long
Declare Function API_DateiSpeichern Lib „comdlg32.dll“ Alias _
„GetSaveFileNameA“ (pOpenfilename As ACL_OPENFILENAME) 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 ‚ new look commdlg
Public Const OFN_EXTENSIONDIFFERENT = &H400
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_LONGNAMES = &H200000 ‚ force long names for 3.x modules
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NOLONGNAMES = &H40000 ‚ force no long names for 4.x modules
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 pOpenfilename As ACL_OPENFILENAME
Type BROWSEINFO
hwndOwner As Long
pidlRoot As Long
lpszDisplayName As String
lpszTitle As String
ulFlags As Long
BFFCALLBACK As Long
LPARAM As Long
iImage As Integer
End Type
Declare Function SHBrowseForFolder Lib „shell32.dll“ (FolderStruct As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib „shell32.dll“ (ByVal LPCITEMIDLIST As Long, ByVal lpStr As String) As Long
Global Const BIF_RETURNONLYFSDIRS = &H1 ‚ For finding a folder to start document searching
Global Const BIF_DONTGOBELOWDOMAIN = &H2 ‚ For starting the Find Computer
Global Const BIF_STATUSTEXT = &H4
Global Const BIF_RETURNFSANCESTORS = &H8
Global Const BIF_BROWSEFORCOMPUTER = &H1000 ‚ Browsing for Computers.
Global Const BIF_BROWSEFORPRINTER = &H2000 ‚ Browsing for Printers
Global Const BIF_BROWSEINCLUDEFILES = &H4000 ‚ Browsing for Everything
Function OpenFolder(Title$) As String
Dim BI As BROWSEINFO
Dim R As Long
Dim lpBuffer As String * 254
With BI
.hwndOwner = 0
.lpszDisplayName = lpBuffer
.lpszTitle = Title$
.ulFlags = 0
.BFFCALLBACK = 0
.LPARAM = 0
End With
R = SHBrowseForFolder(BI)
R = SHGetPathFromIDList(R, lpBuffer)
OpenFolder = Left$(lpBuffer, InStr(lpBuffer, Chr(0)) – 1)
End Function
Function ACL_DateiOeffnen(strVerzeichnis As String, strTitel As String) As String
Dim strFilter As String
Dim strDateinameUndPfad As String
Dim strDateiname As String
Dim lngErgebnis As Long
‚ Angebotene Dateifilter in der Dropdownliste „Dateityp“
strFilter = „Bilddateien (*.bmp;*.gif;*.jpg)“ & Chr$(0) & „*.BMP;*.GIF;*.JPG“ & Chr$(0)
‚ Vorgegebenes Verzeichnis
If strVerzeichnis = „“ Then
strVerzeichnis = CurDir$ & Chr$(0) ‚ Wenn leer, dann das aktuelle Verzeichnis verwenden
Else
strVerzeichnis = strVerzeichnis & Chr$(0) ‚ ANSI „0“ an übergebenes Verzeichnis anhängen
End If
If strTitel = „“ Then
strTitel = „Access Berater: Datei-Öffnen-Dialog“ ‚ Wenn kein Titel übergeben, Standardtitel festlegen
Else
strTitel = strTitel & Chr$(0) ‚ ANSI „0“ an übergebenen Titel anhängen
End If
‚ Speicherplatz für Dateinamen & Pfad reservieren
strDateinameUndPfad = Space$(255) & Chr$(0)
‚ Speicherplatz für Dateinamen ohne Pfad reservieren
strDateiname = Space$(255) & Chr$(0)
‚Datenstruktur von pOPENFILENAME festlegen
pOpenfilename.lStructSize = Len(pOpenfilename)
pOpenfilename.hwndOwner = 0&
‚pOpenfilename.hwndOwner = Application.hWndAccessApp
pOpenfilename.lpstrFilter = strFilter
pOpenfilename.nFilterIndex = 1
pOpenfilename.lpstrFile = strDateinameUndPfad
pOpenfilename.nMaxFile = Len(strDateinameUndPfad)
pOpenfilename.lpstrFileTitle = strDateiname
pOpenfilename.nMaxFileTitle = Len(strDateiname)
pOpenfilename.lpstrInitialDir = strVerzeichnis
pOpenfilename.lpstrTitle = strTitel
pOpenfilename.Flags = OFN_FILEMUSTEXIST Or OFN_PATHMUSTEXIST Or OFN_HIDEREADONLY
pOpenfilename.nFileOffset = 0
pOpenfilename.nFileExtension = 0
pOpenfilename.lCustData = 0
pOpenfilename.lpfnHook = 0
pOpenfilename.lpTemplateName = „“
lngErgebnis = API_DateiOeffnen(pOpenfilename)
If lngErgebnis <> 0 Then
ACL_DateiOeffnen = Left(pOpenfilename.lpstrFile, InStr(pOpenfilename.lpstrFile, Chr$(0)) – 1)
Else
ACL_DateiOeffnen = „“
End If
‚ If lngErgebnis <> 0 Then
‚ ACL_DateiOeffnen = Left(pOpenfilename.lpstrFile, pOpenfilename.nFileOffset – 1) & _
‚ „*“ & Mid$(pOpenfilename.lpstrFile, pOpenfilename.nFileOffset + 1, _
‚ pOpenfilename.nFileExtension – pOpenfilename.nFileOffset – 1) & „*“ & _
‚ Mid$(pOpenfilename.lpstrFile, pOpenfilename.nFileExtension + 1, Len(pOpenfilename.lpstrFile) – pOpenfilename.nFileExtension)
‚ Else
‚ ACL_DateiOeffnen = „“
‚ End If
End Function
Function ACL_DateiSpeichern(strVerzeichnis As String, strTitel As String) As String
Dim strFilter As String
Dim strDateinameUndPfad As String
Dim strDateiname As String
Dim lngErgebnis As Long
‚ Angebotene Dateifilter in der Dropdownliste „Dateityp“
strFilter = „Access-Datenbanken (*.mdb; *.mde)“ & Chr$(0) & „*.MDB; *.MDE“ & Chr$(0)
‚ Vorgegebenes Verzeichnis
If strVerzeichnis = „“ Then
strVerzeichnis = CurDir$ & Chr$(0) ‚ Wenn leer, dann das aktuelle Verzeichnis verwenden
Else
strVerzeichnis = strVerzeichnis & Chr$(0) ‚ ANSI „0“ an übergebenes Verzeichnis anhängen
End If
If strTitel = „“ Then
strTitel = „Access Berater: Datei-Speichern-Dialog“ ‚ Wenn kein Titel übergeben, Standardtitel festlegen
Else
strTitel = strTitel & Chr$(0) ‚ ANSI „0“ an übergebenen Titel anhängen
End If
‚ Speicherplatz für Dateinamen & Pfad reservieren
strDateinameUndPfad = Space$(255) & Chr$(0)
‚ Speicherplatz für Dateinamen ohne Pfad reservieren
strDateiname = Space$(255) & Chr$(0)
‚Datenstruktur von pOPENFILENAME festlegen
pOpenfilename.lStructSize = Len(pOpenfilename)
pOpenfilename.hwndOwner = 0&
‚pOpenfilename.hwndOwner = Application.hWndAccessApp
pOpenfilename.lpstrFilter = strFilter
pOpenfilename.nFilterIndex = 1
pOpenfilename.lpstrFile = strDateinameUndPfad
pOpenfilename.nMaxFile = Len(strDateinameUndPfad)
pOpenfilename.lpstrFileTitle = strDateiname
pOpenfilename.nMaxFileTitle = Len(strDateiname)
pOpenfilename.lpstrInitialDir = strVerzeichnis
pOpenfilename.lpstrTitle = strTitel
pOpenfilename.Flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT
pOpenfilename.nFileOffset = 0
pOpenfilename.nFileExtension = 0
pOpenfilename.lCustData = 0
pOpenfilename.lpfnHook = 0
pOpenfilename.lpTemplateName = „“
lngErgebnis = API_DateiSpeichern(pOpenfilename)
If lngErgebnis <> 0 Then
ACL_DateiSpeichern = Left(pOpenfilename.lpstrFile, InStr(pOpenfilename.lpstrFile, Chr$(0)) – 1)
Else
ACL_DateiSpeichern = „“
End If
‚ If lngErgebnis <> 0 Then
‚ ACL_Speichern = Left(pOpenfilename.lpstrFile, pOpenfilename.nFileOffset – 1) & _
‚ „*“ & Mid$(pOpenfilename.lpstrFile, pOpenfilename.nFileOffset + 1, _
‚ pOpenfilename.nFileExtension – pOpenfilename.nFileOffset – 1) & „*“ & _
‚ Mid$(pOpenfilename.lpstrFile, pOpenfilename.nFileExtension + 1, Len(pOpenfilename.lpstrFile) – pOpenfilename.nFileExtension)
‚ Else
‚ ACL_Speichern = „“
‚ End If
End Function