Avatar billede compilos Nybegynder
04. september 2001 - 16:15 Der er 11 kommentarer og
2 løsninger

Hvis sti?

Jeg er ved at lave et lille program i access der importer nogle filer. Jeg vil gerne lave det sådan at man kan klikke sig ned til biblioteket - hvor filerne ligger.
programmet jeg laver kender de filer der skal importeres - så jeg skal bare kunne klikke mig der ned.  Hvad er mulighedderne  - er der ikke en komponent til dette.
Avatar billede terry Ekspert
04. september 2001 - 19:16 #1
yes you can use the common dialog control
You should be able to find it in the toolbox

This is an example as to how you use it, but you will have to modify it to suit your needs

Call a function to set the path and filename

Public Function GetDocument()
Dim InitDir As String

    \' Set CancelError is True
   
    Me.AXComDlg.CancelError = True
    Me.AXComDlg.DialogTitle = \"Link Document\"
   
    On Error GoTo Err_GetDocument
    \' Set flags
    Me.AXComDlg.Flags = cdlOFNHideReadOnly + cdlOFNFileMustExist
    \' Set filters
 
    Me.AXComDlg.Filter = \"All Files (*.*)|*.*\"
   
    If Not IsNull(Me.DocumentName) Then
        Me.AXComDlg.InitDir = Me.DocumentLink
    End If
       
    \' Specify default filter
    Me.AXComDlg.FilterIndex = 2
    \' Display the Open dialog box
    Me.AXComDlg.ShowOpen
    \' Display name of selected file

Exit_GetDocument:
    Exit Function
   
Err_GetDocument:
    \'User pressed the Cancel button
    Exit Function

End Function
Avatar billede terry Ekspert
04. september 2001 - 19:18 #2
Me.DocumentName and Me.DocumentLink

are names of fields in my program.

AXComDlg is the name of the common dialog
       
   
05. september 2001 - 09:00 #3
Jeg har den holdning, at man skal undgå ActiveX-componenter, hvis man kan. Når man distribuere sin database, skal således altid sørge for at distribuere komponenten med. Og den skal som regel registreres på client-maskinen osv.

Derfor vil jeg hellere kode mig ud af problemerne.

Nu er OpenFile-dialog-boksen én af de mere komplicerede at kode selv, derfor er det godt at andre har opfundet den dybe tallerken før mig ;o)

Nedenstående kode (som er ret lang) er henter fra Dev Ashish\'s geniale website http://www.mvps.org/access/ :

Funktionen TestIt fortæller dig hvordan du skal bruge den. Du skal blot copy/paste koden ind i et globalt modul.

\'******* Code start *****************************
Type tagOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Declare Function aht_apiGetOpenFileName Lib \"comdlg32.dll\" _
    Alias \"GetOpenFileNameA\" (OFN As tagOPENFILENAME) As Boolean

Declare Function aht_apiGetSaveFileName Lib \"comdlg32.dll\" _
    Alias \"GetSaveFileNameA\" (OFN As tagOPENFILENAME) As Boolean
Declare Function CommDlgExtendedError Lib \"comdlg32.dll\" () As Long

Global Const ahtOFN_READONLY = &H1
Global Const ahtOFN_OVERWRITEPROMPT = &H2
Global Const ahtOFN_HIDEREADONLY = &H4
Global Const ahtOFN_NOCHANGEDIR = &H8
Global Const ahtOFN_SHOWHELP = &H10
\' You won\'t use these.
\'Global Const ahtOFN_ENABLEHOOK = &H20
\'Global Const ahtOFN_ENABLETEMPLATE = &H40
\'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
Global Const ahtOFN_NOVALIDATE = &H100
Global Const ahtOFN_ALLOWMULTISELECT = &H200
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
Global Const ahtOFN_PATHMUSTEXIST = &H800
Global Const ahtOFN_FILEMUSTEXIST = &H1000
Global Const ahtOFN_CREATEPROMPT = &H2000
Global Const ahtOFN_SHAREAWARE = &H4000
Global Const ahtOFN_NOREADONLYRETURN = &H8000
Global Const ahtOFN_NOTESTFILECREATE = &H10000
Global Const ahtOFN_NONETWORKBUTTON = &H20000
Global Const ahtOFN_NOLONGNAMES = &H40000
\' New for Windows 95
Global Const ahtOFN_EXPLORER = &H80000
Global Const ahtOFN_NODEREFERENCELINKS = &H100000
Global Const ahtOFN_LONGNAMES = &H200000

Function TestIt()
    Dim strFilter As String
    Dim lngFlags As Long
    strFilter = ahtAddFilterItem(strFilter, \"Access Files (*.mda, *.mdb)\", _
                    \"*.MDA;*.MDB\")
    strFilter = ahtAddFilterItem(strFilter, \"dBASE Files (*.dbf)\", \"*.DBF\")
    strFilter = ahtAddFilterItem(strFilter, \"Text Files (*.txt)\", \"*.TXT\")
    strFilter = ahtAddFilterItem(strFilter, \"All Files (*.*)\", \"*.*\")
    MsgBox \"You selected: \" & ahtCommonFileOpenSave(InitialDir:=\"C:\\\", _
        Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
        DialogTitle:=\"Hello! Open Me!\")
    \' Since you passed in a variable for lngFlags,
    \' the function places the output flags value in the variable.
    Debug.Print Hex(lngFlags)
End Function

Function GetOpenFile(Optional varDirectory As Variant, _
    Optional varTitleForDialog As Variant) As Variant
\' Here\'s an example that gets an Access database name.
Dim strFilter As String
Dim lngFlags As Long
Dim varFileName As Variant
\' Specify that the chosen file must already exist,
\' don\'t change directories when you\'re done
\' Also, don\'t bother displaying
\' the read-only box. It\'ll only confuse people.
    lngFlags = ahtOFN_FILEMUSTEXIST Or _
                ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
    If IsMissing(varDirectory) Then
        varDirectory = \"\"
    End If
    If IsMissing(varTitleForDialog) Then
        varTitleForDialog = \"\"
    End If

    \' Define the filter string and allocate space in the \"c\"
    \' string Duplicate this line with changes as necessary for
    \' more file templates.
    strFilter = ahtAddFilterItem(strFilter, _
                \"Access (*.mdb)\", \"*.MDB;*.MDA\")
    \' Now actually call to get the file name.
    varFileName = ahtCommonFileOpenSave( _
                    OpenFile:=True, _
                    InitialDir:=varDirectory, _
                    Filter:=strFilter, _
                    Flags:=lngFlags, _
                    DialogTitle:=varTitleForDialog)
    If Not IsNull(varFileName) Then
        varFileName = TrimNull(varFileName)
    End If
    GetOpenFile = varFileName
End Function

Function ahtCommonFileOpenSave( _
            Optional ByRef Flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal Filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal FileName As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hwnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant
\' This is the entry point you\'ll use to call the common
\' file open/save dialog. The parameters are listed
\' below, and all are optional.
\'
\' In:
\' Flags: one or more of the ahtOFN_* constants, OR\'d together.
\' InitialDir: the directory in which to first look
\' Filter: a set of file filters, set up by calling
\' AddFilterItem. See examples.
\' FilterIndex: 1-based integer indicating which filter
\' set to use, by default (1 if unspecified)
\' DefaultExt: Extension to use if the user doesn\'t enter one.
\' Only useful on file saves.
\' FileName: Default value for the file name text box.
\' DialogTitle: Title for the dialog.
\' hWnd: parent window handle
\' OpenFile: Boolean(True=Open File/False=Save As)
\' Out:
\' Return Value: Either Null or the selected filename
Dim OFN As tagOPENFILENAME
Dim strFileName As String
Dim strFileTitle As String
Dim fResult As Boolean
    \' Give the dialog a caption title.
    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = \"\"
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = \"\"
    If IsMissing(FileName) Then FileName = \"\"
    If IsMissing(DialogTitle) Then DialogTitle = \"\"
    If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
    \' Allocate string space for the returned strings.
    strFileName = Left(FileName & String(256, 0), 256)
    strFileTitle = String(256, 0)
    \' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hwnd
        .strFilter = Filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .Flags = Flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        \' Didn\'t think most people would want to deal with
        \' these options.
        .hInstance = 0
        \'.strCustomFilter = \"\"
        \'.nMaxCustFilter = 0
        .lpfnHook = 0
        \'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With
    \' This will pass the desired data structure to the
    \' Windows API, which will in turn it uses to display
    \' the Open/Save As Dialog.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    \' The function call filled in the strFileTitle member
    \' of the structure. You\'ll have to write special code
    \' to retrieve that if you\'re interested.
    If fResult Then
        \' You might care to check the Flags member of the
        \' structure to get information about the chosen file.
        \' In this example, if you bothered to pass in a
        \' value for Flags, we\'ll fill it in with the outgoing
        \' Flags value.
        If Not IsMissing(Flags) Then Flags = OFN.Flags
        ahtCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
        ahtCommonFileOpenSave = vbNullString
    End If
End Function

Function ahtAddFilterItem(strFilter As String, _
    strDescription As String, Optional varItem As Variant) As String
\' Tack a new chunk onto the file filter.
\' That is, take the old value, stick onto it the description,
\' (like \"Databases\"), a null character, the skeleton
\' (like \"*.mdb;*.mda\") and a final null character.

    If IsMissing(varItem) Then varItem = \"*.*\"
    ahtAddFilterItem = strFilter & _
                strDescription & vbNullChar & _
                varItem & vbNullChar
End Function

Private Function TrimNull(ByVal strItem As String) As String
Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function
\'************** Code End *****************
Avatar billede terry Ekspert
05. september 2001 - 09:07 #4
Thanks Thomas I can use that myself!

If its included in the setup-kit then it gets registered automatically, and this is one that Microsoft allow to be distributed with your application. Otherwsie I also try to refrain from using ActiveX-components.

mvh
terry
05. september 2001 - 09:17 #5
Hi Terry,

Yeah, this code is very useful :o)

You are right about the setup-kit, but mostly (my experience through 8 years) you don\'t distribute your application in a runtime-setup, but simply deliver the .mdb/.mde-file on a disk or by mail, since the customers usually have Access installed already. Then again, if they have Access, they also have the common dialog-control, but then you have to be sure that its the same version and that it REALY is installed on every machine and so on. But you know all that ;o)

Actually I don\'t know why this isn\'t a build-in function in Access. It is in Word and Excel !!??

/Thomas
Avatar billede compilos Nybegynder
05. september 2001 - 11:38 #6
Hej.
Jeg tror der er en måde der er letter. Jeg har kun brug for at kunne klikke mig frem til et bestemt bibliotek - og så vise biblioteks-stien i en textbox. Ikke noget med at åbne filer - Men jeg syntes det ville være en god ide hvis man kan lave det med API.
05. september 2001 - 11:41 #7
Okay, så kan du nøjes med denne kode:

Private Type BROWSEINFO
  hOwner As Long
  pidlRoot As Long
  pszDisplayName As String
  lpszTitle As String
  ulFlags As Long
  lpfn As Long
  lParam As Long
  iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib \"Shell32.dll\" Alias _
            \"SHGetPathFromIDListA\" (ByVal pidl As Long, _
            ByVal pszPath As String) As Long
           
Private Declare Function SHBrowseForFolder Lib \"Shell32.dll\" Alias _
            \"SHBrowseForFolderA\" (lpBrowseInfo As BROWSEINFO) _
            As Long
           
Private Const BIF_RETURNONLYFSDIRS = &H1
Public Function BrowseFolder(szDialogTitle As String) As String
  Dim X As Long, bi As BROWSEINFO, dwIList As Long
  Dim szPath As String, wPos As Integer
 
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS
    End With
   
    dwIList = SHBrowseForFolder(bi)
    szPath = Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
   
    If X Then
        wPos = InStr(szPath, Chr(0))
        BrowseFolder = Left$(szPath, wPos - 1)
    Else
        BrowseFolder = \"\"
    End If
End Function

Du bruger den således:

Me!Textbox = BrowseFolder(\"Angiv sti\")

/Thomas
Avatar billede compilos Nybegynder
05. september 2001 - 11:49 #8
Thomasjepsen - very nice.

Det var lige det jeg skulle bruge. 60 point til dig.

Da jeg nu er glad får terry 20 point for indsatsen.

TAK - begge 2
05. september 2001 - 11:52 #9
Øh, jeg fik nu kun 20.....men jeg er godt klar over hvad du gjorde forkert ;o)
Avatar billede terry Ekspert
05. september 2001 - 11:55 #10
Who wants the extra 20?
Avatar billede compilos Nybegynder
05. september 2001 - 11:57 #11
Jeg kan da lige lave et nyt spørgsmål. 
Hvem fik egentligt hvad
Avatar billede terry Ekspert
05. september 2001 - 11:59 #12
I got 40 and Thomas 20 (I think)
Avatar billede compilos Nybegynder
05. september 2001 - 12:08 #13
106050. Thomas - du kan bare svare så jeg kan få lukket det igen
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Dyk ned i databasernes verden på et af vores praksisnære Access-kurser

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester