Vælge en fil

Ummidelbart er der ingen muligheder for dette i VB, commondialog har kun fil udvælgelse, derfor er det en god idé at lave din egen form der evt. ligner commondialog\'en.

/Jimmi

Jeg har ofte set programmer få sådan en \"træ-visning\" af drev med mapper osv. Hvor man her kan vælge en mappe, hvis du ved hvilken een jeg taler om, er det så ikke muligt at få sådan en kaldt frem? Måske via et API kald?

Mvh Mark

Her er et modul, som giver dig mulighed for at bruge Window\'s Browse for Folder dialog. Du skal bruge funktionen GetFolder.

Attribute VB_Name = \"modShell\"
Option Explicit

Private Const sModName As String = \"modShell\"
Global bCanDoAutoComplete As Boolean

\' SHGetSpecialFolderLocation successful rtn val
Private Const NOERROR = 0
\' Maximum allowed path length including path, filename,  and command line arguments for NT (Intel) and Win95.
Private Const MAX_PATH_LEN% = 260

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfnCallBackProc As Long
    lParam As Long
    iImage As Long
End Type

\'BROWSEINFO.ulFlags values:

Public Enum FolderBrowseOptions
    fboRETURNONLYFSDIRS = &H1
    fboDONTGOBELOWDOMAIN = &H2
    fboSTATUSTEXT = &H4
    fboRETURNFSANCESTORS = &H8
    fboEDITBOX = &H10
    fboVALIDATE = &H20
    fboUSENEWUI = &H40
    fboBROWSEFORCOMPUTER = &H1000
    fboBROWSEFORPRINTER = &H2000
    fboBROWSEINCLUDEFILES = &H4000
End Enum

\' Special Folder ID
Public Enum SpecialFolderIDs
    sfidDESKTOP = &H0
    sfidPROGRAMS = &H2
    sfidPERSONAL = &H5
    sfidFAVORITES = &H6
    sfidSTARTUP = &H7
    sfidRECENT = &H8
    sfidSENDTO = &H9
    sfidSTARTMENU = &HB
    sfidDESKTOPDIRECTORY = &H10
    sfidNETHOOD = &H13
    sfidFONTS = &H14
    sfidTEMPLATES = &H15
    sfidCOMMON_STARTMENU = &H16
    sfidCOMMON_PROGRAMS = &H17
    sfidCOMMON_STARTUP = &H18
    sfidCOMMON_DESKTOPDIRECTORY = &H19
    sfidAPPDATA = &H1A
    sfidPRINTHOOD = &H1B
    sfidProgramFiles = &H10000
    sfidCommonFiles = &H10001
End Enum

Private Const WM_USER = &H400

\' Browse Call back events
Private Const BFFM_INITIALIZED = 1
Private Const BFFM_SELCHANGED = 2
Private Const BFFM_VALIDATEFAILED = 3

\' Browse Call back messages
Private Const BFFM_ENABLEOK = (WM_USER + 101)
Private Const BFFM_SETSELECTIONA = (WM_USER + 102)
Private Const BFFM_SETSTATUSTEXTA = (WM_USER + 100)


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 Declare Sub CoTaskMemFree Lib \"ole32.dll\" (ByVal pv As Long)
Private Declare Function SHGetSpecialFolderLocation Lib \"Shell32\" (ByVal hwndOwner As Long, ByVal nFolder As SpecialFolderIDs, ByRef pidl As Long) As Long

Private Declare Function SendMessage Lib \"user32\" Alias \"SendMessageA\" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function LocalAlloc Lib \"kernel32\" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib \"kernel32\" (ByVal hMem As Long) As Long
Private Declare Function lstrcpyA Lib \"kernel32\" (lpString1 As Any, lpString2 As Any) As Long
Private Declare Function lstrlenA Lib \"kernel32\" (lpString As Any) As Long

Private Const LMEM_FIXED = &H0
Private Const LMEM_ZEROINIT = &H40
Private Const LPTR = (LMEM_FIXED Or LMEM_ZEROINIT)


\' Currently (SHACF_FILESYSTEM | SHACF_URLALL)
Private Const SHACF_DEFAULT  As Long = &H0
\' This includes the File System as well as the rest of the shell
\' (Desktop\\My Computer\\Control Panel\\)
Private Const SHACF_FILESYSTEM As Long = &H1
\' URLs in the User\'s History
Private Const SHACF_URLHISTORY As Long = &H2
\' URLs in the User\'s Recently Used list.
Private Const SHACF_URLMRU As Long = &H4
\' Tab completition
Private Const SHACF_USETAB = &H8
\' Don\'t AutoComplete non-File System items.
Private Const SHACF_FILESYS_ONLY = &H10
\' Both File System and URLs in the User\'s History
Private Const SHACF_URLALL As Long = (SHACF_URLHISTORY Or SHACF_URLMRU)

Public Function FARPROC(pfn As Long) As Long
  \'A dummy procedure that receives and returns the return value of the AddressOf operator
  FARPROC = pfn
End Function

Public Function GetSpecialFolderLocation(sFolder As Long) As String
    \' This function will get the path to a special folder location. Just pass the
    \' special folder ID (See SpecialFolderIDs Enum) and a path will be returned to
    \' that special folder.
   
    Dim sPath As String
    Dim IDL As Long
    Dim nPos As Long
   
    \' Get PIDL of the special folder
    \' Returns NOERROR if successful, or an  OLE-defined error result otherwise.
    If SHGetSpecialFolderLocation(0, sFolder, IDL) = NOERROR Then
        \' Set up string to hold information
        sPath = String$(MAX_PATH_LEN, 0)
        \' Converts an item identifier list to a file system path
        SHGetPathFromIDList IDL, sPath
        \' Trim sPath to hold only the desired characters (remove NULL\'s)
        nPos = InStr(1, sPath, Chr$(0))
        If nPos > 0 Then
            \' NULL character was present. Strip all NULL chars from the string
            GetSpecialFolderLocation = Left(sPath, nPos - 1)
        Else
            \' No null chars present. Just return the string
            GetSpecialFolderLocation = sPath
        End If
    End If
   
End Function

Public Function BrowseCallbackProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal lParam As Long, ByVal lpData As Long) As Long
    Select Case Msg
        Case BFFM_INITIALIZED
            SendMessage hWnd, BFFM_SETSELECTIONA, True, ByVal lpData
    End Select
End Function

Public Function GetFolder(ByVal hWndModal As Long, Optional Title As String = \"\", _
                                                Optional Options As FolderBrowseOptions = fboRETURNONLYFSDIRS, _
                                                Optional StartDir As String = \"\") As String
    Dim bInf As BROWSEINFO
    Dim lpSelPath As Long
    Dim RetVal As Long
    Dim PathID As Long
    Dim RetPath As String
    Dim Offset As Integer
   
    \'Set the properties of the folder dialog
    With bInf
        .hOwner = hWndModal
        .lpszTitle = Title
        .ulFlags = Options
        If StartDir <> \"\" Then
            .lpfnCallBackProc = FARPROC(AddressOf BrowseCallbackProc)
            lpSelPath = LocalAlloc(LPTR, Len(StartDir) + 1)
          CopyMemory ByVal lpSelPath, ByVal StartDir, Len(StartDir) + 1
          .lParam = lpSelPath
        End If
    End With
   
    \'Show the Browse For Folder dialog
    PathID = SHBrowseForFolder(bInf)
    RetPath = Space$(512)
    RetVal = SHGetPathFromIDList(ByVal PathID, ByVal RetPath)
    If RetVal Then
          \'Trim off the null chars ending the path and display the returned folder
          Offset = InStr(RetPath, Chr$(0))
          GetFolder = Left$(RetPath, Offset - 1)
          \'Free memory allocated for PIDL
          CoTaskMemFree PathID
    Else
          GetFolder = \"\"
    End If
    If StartDir <> \"\" Then LocalFree lpSelPath
End Function

hvis du lægger flg. kode i et modul i Visual basic

Public Const BIF_RETURNONLYFSDIRS = 1
    Public Const BIF_DONTGOBELOWDOMAIN = 2
   
    Public Const MAX_PATH = 260
   
    Public Declare Function SHBrowseForFolder Lib \"shell32\" (lpbi As BrowseInfo) As Long
    Public Declare Function SHGetPathFromIDList Lib \"shell32\" (ByVal pidlist As Long, ByVal lpBuffer As String) As Long
    Public Declare Function lstrcat Lib \"kernel32\" Alias \"lstrcatA\" (ByVal lpstring1 As String, ByVal lpstring2 As String) As Long
   
    Public Type BrowseInfo
        hWndOwner As Long
        pIDLRoot As Long
        pszDisplayName As Long
        lpszTitle As Long
        ulFlags As Long
        lpfnCallBack As Long
        lparam As Long
        iImage As Long
    End Type



og lægger flg. kode i formularens kode modul

Private Sub Form_Load()
   
    Dim lpIDList As Long
    Dim sBuffer As String
    Dim szTitle As String
    Dim tBrowseInfo As BrowseInfo
   
    szTitle = \"Vælg bibliotek\"
   
    With tBrowseInfo
        .hWndOwner = Form1.hWnd
        .lpszTitle = lstrcat(szTitle, \"\")
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
       
    lpIDList = SHBrowseForFolder(tBrowseInfo)
   
    If (lpIDList) Then
        sBuffer = Space(MAX_PATH)
        SHGetPathFromIDList lpIDList, sBuffer
        sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
        Text1 = sBuffer
    End If
End Sub

Så vil du kunne bruge den funktionalitet du efterlyser.

Kedde

Jeg føler næsten at 15 point er for lidt... :). Tak til jer alle, Kedde gav mig det endelige svare som virkede.

Kedde -> Hvis du vil have lidt flere point så sig til :)

Hvis du laver en fordobling, så er jeg tilfreds.

Kedde

No problem :)

http://www.eksperten.dk/spm/132245