Access 2000, Datei suchen Dialog

Computer: Software & Programmierung Datenbanken allgemein
#1

Hallo

Gibt’s in Access 2000 irgeneine Möglichkeit aus dem VBA ein Dialog aufzurufen mit dem man ein File suchen gehen kann, wie zum Beispiel kann man ja in Visual Basic einen solchen Dialog aufrufen (Speichern unter).

Danke für eure Hilfe

Andreas

#2

Zum einen kannst du das VB Common-Dialog-ActiveX auch in Access verwenden. Zum anderen kannst du - ressourcenschonender - die entsprechenden Funktionen auch direkt in der Common-Dialog-DLL aufrufen:

Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" \_
 (pOpenfilename As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" \_
 (pOpenfilename As OPENFILENAME) As Long

Public Const OFN\_READONLY = &H1
Public Const OFN\_HIDEREADONLY = &H4
Public Const OFN\_FILEMUSTEXIST = &H1000

Type 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 Long
End Type

Private Const MAX\_PATH = 260

Public Function FileDialog(Optional OpenSave As Boolean = True, \_
 Optional Titel As String, Optional Filter As String, \_
 Optional DefExtension As String, Optional AktDir As String, \_
 Optional Flags As Long) As String

On Error GoTo FErr
Dim Res As Long, OpenDlg As OPENFILENAME, DateiName As String

 DateiName = String$(512, 0)

 With OpenDlg
 If IsMissing(Titel) Then
 If OpenSave Then
 .lpstrTitle = "Datei öffnen" & Chr$(0)
 Else
 .lpstrTitle = "Datei speichern unter" & Chr$(0)
 End If
 Else
 .lpstrTitle = Titel & Chr$(0)
 End If

 If IsMissing(Filter) Then
 .lpstrFilter = "Alle Dateien" & Chr$(0) & "\*.\*" & Chr$(0) & Chr$(0)
 Else
 If InStr(Filter, "|") \> 0 Then
 .lpstrFilter = StrSubs(Filter, "|", Chr$(0)) & Chr$(0)
 Else
 .lpstrFilter = Filter & Chr$(0)
 End If
 End If

 If IsMissing(DefExtension) Then
 .lpstrDefExt = Chr$(0)
 Else
 .lpstrDefExt = DefExtension & Chr$(0)
 End If

 If IsMissing(AktDir) Then
 .lpstrInitialDir = CurDir$ & Chr$(0)
 Else
 .lpstrInitialDir = AktDir & Chr$(0)
 End If

 If IsMissing(Flags) Then
 If OpenSave Then
 .Flags = OFN\_FILEMUSTEXIST Or OFN\_READONLY ' bzw. HideReadOnly
 Else
 .Flags = 0
 End If
 Else
 .Flags = Flags
 End If

 .lStructSize = Len(OpenDlg)
 .hWndOwner = 0
 On Error Resume Next
 .hWndOwner = Screen.ActiveForm.hWnd
 On Error GoTo FErr
 .nFilterIndex = 1
 .lpstrFile = DateiName
 .nMaxFile = Len(DateiName)
 If OpenSave Then
 Res = GetOpenFileName(OpenDlg)
 Else
 Res = GetSaveFileName(OpenDlg)
 End If
 If Res 0 Then
 FileDialog = left$(.lpstrFile, InStr(.lpstrFile, Chr$(0)) - 1)
 Else
 FileDialog = ""
 End If
 End With

FExit:
 On Error Resume Next
 Exit Function

FErr:
 MsgBox error$
 Resume FExit
End Function

Reinhard

#3

Hallo Reinhard

If InStr(Filter, „|“) > 0 Then
.lpstrFilter = StrSubs(Filter,
„|“, Chr$(0)) & Chr$(0)

Danke für deine Antwort, kannst du mir noch sagen welcher Verweis ich noch anwählen muss denn mein Access erkennt die Funktion „StrSubs“ nicht.

Danke

Gruss Andreas

#4

StrSubs stammt aus meinem Fundus - sorry:

Function StrSubs(s, Subs, Optional Repl = "", Optional N = 0)
'
' Teilzeichenkette \>SubsSRepln 0, sonst alle ersetzen
' Funktionswert: Falsch, wenn S = Null
'
Dim FPos As Integer, I As Integer, Res As String
On Error GoTo Er
 If Nz(s, "") = "" Then StrSubs = Null: GoTo Ex
 If Nz(Subs, "") Then StrSubs = s: GoTo Ex
 Res = s
 I = 0
 FPos = InStr(1, Res, Subs)
 Do While FPos \> 0
 I = I + 1
 If N \> 0 And I \> N Then Exit Do
 If FPos \> 1 Then
 Res = Mid(Res, 1, FPos - 1) & Repl & Mid(Res, FPos + Len(Subs))
 Else
 Res = Repl & Mid(Res, FPos + Len(Subs))
 End If
 FPos = InStr(FPos + Len(Repl), Res, Subs)
 Loop
 StrSubs = Res

Ex:
 Exit Function

Er:
 MsgBox error$
 Resume Ex
End Function
#5

Hallo Reinhard

Danke nochmals für deine zweite Antwort

Ich hab da noch eine Frage:

Wie kann ich den Filter anwenden?? Das heisst was für Parameter muss ich dem [Filter As String] oder dem [DefExtension As String] mitgeben??

Ich habs mit „*.mdb“ probiert.

Danke für Antwort

Andreas

#6

Ein typischer Aufruf sieht so aus:

Tmp = FileDialog(True, „Datei öffnen“, _
„Textdateien (*.txt)|*.txt|Temporäre Dateien (*.tmp)|*.tmp|Alle Dateien (*.*)|*.*“, _
„*.tmp“, „C:\TEMP“)

Der Anfang von StrSubs sollte übrigens besser so aussehen:

On Error GoTo Er
If IsNull(s) Then StrSubs = Null: GoTo Ex
If IsNull(Subs) Then StrSubs = s: GoTo Ex
Res = s

Reinhard