filbrowser på access formular

Der er flere modeller, hvor nogle af dem kræver ActiveX-komponenter.

Jeg har et eksempel på én liggende her: http://www.makeiteasy.dk/eksempler/Downloads.htm, som udelukkende er kodegenereret, og som er den smarteste, jeg selv har set indtil nu.

Eksemplet hedder: Åbn Fil-dialogboks og åbning af vilkårlig fil fra Access

Jeg har ikke lidt på din hjemmeside. Og det ser rigtigt fint ud. Men jeg kører access 97, så jeg kan ikke åbne dine eksempler.

ah...sorry o:(

Prøv evt denne kode, som virker i alle versioner. Kopier hele koden ind i et modul og afprøv funktionen Demo (f.eks. med F5):


Private Declare Function api_GetOfficeFileName _
Lib "msaccess.exe" Alias "#56" (gfni As typOffFileNameInfo, fOpen As Integer) As Long

' Common Dialogs
' OfficeGetFileName errors
Public Const adhcAccErrGFNSuccess As Long = 0
Public Const adhcAccErrGFNCantOpenDialog As Long = -301
Public Const adhcAccErrGFNUserCancelledDialog As Long = -302

' OfficeGetFileName flags
Public Const adhcGfniConfirmReplace As Long = &H1    ' Prompt if overwriting a file?
Public Const adhcGfniNoChangeDir As Long = &H2        ' Don't change to the directory the user selected?
Public Const adhcGfniAllowMultiSelect As Long = &H8  ' Allow multiple-selection?
Public Const adhcGfniDirectoryOnly As Long = &H20    ' Open as directory picker?
Public Const adhcGfniInitializeView As Long = &H40    ' Initialize the view to the lView member or use last selected view?

' Views in the Office Find File dialog
Public Const adhcGfniViewDetails As Long = 0          ' Details
Public Const adhcGfniViewPreview As Long = 1          ' Preview
Public Const adhcGfniViewProperties As Long = 2      ' Properties
Public Const adhcGfniViewList As Long = 3            ' List (typical)

Public Type typOffFileNameInfo
  hwndOwner As Long
  strAppName As String * 255
  strDlgTitle As String * 255
  strOpenTitle As String * 255
  strFile As String * 4096
  strInitialDir As String * 255
  strFilter As String * 255
  lngFilterIndex As Long
  lngView As Long
  lngFlags As Long
End Type

'Browse for folder items
Private Type typBrowseInfo
  lngOwner As Long
  lngRoot As Long
  strDisplayName As String
  strTitle As String
  lngFlags As Long
  lngx As Long
  lngParam As Long
  lngImage As Long
End Type

Private Const BFF_ReturnOnlyDirs As Long = &H1

Private Declare Function hp_GetPathFromIDList Lib "Shell32.dll" Alias _
            "SHGetPathFromIDListA" (ByVal lngID As Long, _
            ByVal strPath As String) As Long
           
Private Declare Function hp_BrowseForFolder Lib "Shell32.dll" Alias _
            "SHBrowseForFolderA" (lpBrowseInfo As typBrowseInfo) _
            As Long

Private Const conDatExt As String = ".MDB"


Public Function fhpGetOffFileName(typFile As typOffFileNameInfo, ByVal fOpen As Integer) As Long
' -----------------------------------------------------------------------------------
' Purpose      : Use Office filename selector in Access
' Called from  :
' Returns      :
' Remarks      : Requires example to be explained
' -----------------------------------------------------------------------------------
  Dim lngx As Long                                        'Testvariable
 
  With typFile
    .strAppName = RTrim(.strAppName) & vbNullChar        'Add null char
    .strDlgTitle = RTrim(.strDlgTitle) & vbNullChar
    .strOpenTitle = RTrim(.strOpenTitle) & vbNullChar
    .strFile = RTrim(.strFile) & vbNullChar
    .strInitialDir = RTrim(.strInitialDir) & vbNullChar
    If Len(fhpTrimNull(RTrim(.strFilter))) = 0 Then      'Check filter string
      .strFilter = "All Files (*.*)"
      .lngFilterIndex = 1
    End If
    .strFilter = RTrim(.strFilter) & vbNullChar
    lngx = api_GetOfficeFileName(typFile, fOpen)          'Open file dialog
       
    .strAppName = fhpTrimNull(.strAppName)                'Remove null char
    .strDlgTitle = fhpTrimNull(.strDlgTitle)
    .strOpenTitle = fhpTrimNull(.strOpenTitle)
    .strFile = fhpTrimNull(.strFile)
    .strInitialDir = fhpTrimNull(.strInitialDir)
    .strFilter = fhpTrimNull(.strFilter)
  End With
  fhpGetOffFileName = lngx                                'Return filename

End Function

Public Function fhpTrimNull(strInput As String) As String
  Dim intX As Integer                                'Counter
  intX = InStr(1, strInput, vbNullChar)              'First null char
  Select Case intX
    Case Is > 1
      fhpTrimNull = Left(strInput, intX - 1)          'Return left of null char
    Case 0
      fhpTrimNull = strInput                          'Return input string
    Case 1
      fhpTrimNull = vbNullString                      'Return null char
  End Select

End Function

Public Function Demo() As String
On Error GoTo Error_Demo
  Dim typFile As typOffFileNameInfo                                'Office filedialog
  With typFile                                                      'Setup dialog
    .hwndOwner = Application.hWndAccessApp
    .strDlgTitle = "Hvor er den nye datafil placeret ?"
    .strOpenTitle = "Åbn"
    .strFile = ""
    .strInitialDir = CurDir & ""
    .strFilter = "Access databaser (*.MDB)|Alle filer (*.*)"
    .lngFilterIndex = 0
    .lngView = adhcGfniViewList
    .lngFlags = adhcGfniNoChangeDir Or adhcGfniInitializeView
  End With
  If fhpGetOffFileName(typFile, True) = adhcAccErrGFNSuccess Then
    Demo = Trim(typFile.strFile)                  'Return filename
  Else
    Demo = ""                                      'No file selected
  End If

Exit_Demo:
  Exit Function

Error_Demo:
  Demo = ""                                          'No file selected
  Resume Exit_Demo

End Function

Endvidere er der et eksempel her på den geniale Access Web-side: http://www.mvps.org/access/api/api0001.htm

Det ser rigtigt godt ud!
Hvis jeg tyder koden rigtigt, skal jeg bare overføre funktionsværdien 'demo' til tekstboksen. Er det korrekt?

sorry....var ved at skrive et svar før, men blev afbrudt....og glemte det, da jeg kom tilbage. Beklager ventetiden :o(

Ja, i princippet kan du bruge funktionsværdien af Demo, men det ville måske være pænere, hvis du lage koden direkte på knappen. Eller lavede Demo-funktionen om, så den kunne bruges generelt (og ikke længere hed Demo). Prøv denne:

Public Function GetFileDialog(Titel as string) As String
On Error GoTo Error_GetFileDialog
  Dim typFile As typOffFileNameInfo                                'Office filedialog
  With typFile                                                      'Setup dialog
    .hwndOwner = Application.hWndAccessApp
    .strDlgTitle = Titel
    .strOpenTitle = "Åbn"
    .strFile = ""
    .strInitialDir = CurDir & ""
    .strFilter = "Access databaser (*.MDB)|Alle filer (*.*)"
    .lngFilterIndex = 0
    .lngView = adhcGfniViewList
    .lngFlags = adhcGfniNoChangeDir Or adhcGfniInitializeView
  End With
  If fhpGetOffFileName(typFile, True) = adhcAccErrGFNSuccess Then
    GetFileDialog = Trim(typFile.strFile)                  'Return filename
  Else
    GetFileDialog = ""                                      'No file selected
  End If

Exit_GetFileDialog:
  Exit Function

Error_GetFileDialog:
  GetFileDialog = ""                                          'No file selected
  Resume Exit_GetFileDialog

End Function