DirListBox!!!!!! Where is in VBA? 2

[Gti]

There is any control in VBA, to make a DirListBox?

 

[Databaseguy]

There is a File Browser (Common Dialog) included in the Active X controls add in. But it only comes with the Developer edition or VB 6.0

As an alternitive, you can use an API call, but I forget which one exaclty does the trick. Tyrone Lumley
augerinn@gte.net

http://server47.hypermart.net/databaseguy

 

[downwitchyobadself]

Is this what you mean?

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
  Dim bi        As BROWSEINFO
  Dim dwIList   As Long
  Dim szPath    As String
  Dim 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

 

[Aivars]

Hi, downwitchyobadself!

It works good. Can you write some comments of these codes?

Aivars

 

[Aivars]

In addition: is it possibly to set default folder by using this method?

Aivars

 

[Databaseguy]

That's the API call I was thinkin' of... Tyrone Lumley
augerinn@gte.net

http://server47.hypermart.net/databaseguy

 

[downwitchyobadself]

No default value allowed, as far as I can tell. Not sure what you want me to comment? It's quite straightforward; post all the code into the same clean module (that way you'll actually be able to read it as code), I don't save anything else in there. The comments are in the variables themselves...

Use it like this:

Dim strMyFileNmWithPath as string

strMyFileNmWithPath = BrowseFolder("Describe window here")

If Len(strMyFileNmWithPath) > 0
   'you got a file name; do something with it
Else
   'user cancelled
End if

 

[Aivars]

I already have this. I would like to set before selected folder in the folder dialog window on second time like it's possibly to do in Common Dialog control. In opposite each time it's needed to start folder searching from root folder.

Do you understand what I mean?
Aivars

 

[downwitchyobadself]

Then you actually want this. (Sorry, it's long.)

Difference being, you can set a context folder, but you have to grab a file with the code, not just a folder like with the Browse procedure. Copy this into a module, you'll read it better.

'OpenFile Dialog
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_EXPLORER = &H80000
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_LONGNAMES = &H200000
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_NODEREFERENCELINKS = &H100000
Private Const OFN_NOLONGNAMES = &H40000
Private Const OFN_NONETWORKBUTTON = &H20000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_READONLY = &H1
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
Private Const OFN_SHOWHELP = &H10

Public Type tOpenFileName
    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 GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As tOpenFileName) As Long

Public Function GetFullFileName(ByVal pstrTitle As String, _
                       Optional ByVal pstrFilter As String = "", _
                       Optional ByVal pstrExtension As String = "", _
                       Optional ByVal pstrFolder As String = vbNullString, _
                       Optional ByVal pstrCurrentFile As String = vbNullString) _
                                As String
    
    Dim ofn As tOpenFileName
    Dim strFilter As String
    Dim strFile As String
    Dim frm As Form
    
    Set frm = CodeContextObject
    If (pstrFilter <> &quot;&quot; And pstrExtension <> &quot;&quot;) Then
        strFilter = vbNullString & pstrFilter & &quot; (*.&quot; & pstrExtension & &quot;)&quot; & vbNullChar & &quot;*.&quot; & pstrExtension
    Else
        strFilter = vbNullString & &quot;All files (*.*)&quot; & vbNullChar & &quot;*.*&quot;
    End If
    
    With ofn
        .lStructSize = Len(ofn)
        .hwndOwner = frm.hWnd
        .lpstrFilter = strFilter & vbNullChar & vbNullChar
        .nFilterIndex = 1
        .lpstrFile = String(255, 0)
        .nMaxFile = Len(.lpstrFile)
        .lpstrFileTitle = String(255, 0)
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = pstrFolder
        .lpstrTitle = pstrTitle
        .flags = OFN_OVERWRITEPROMPT Or OFN_HIDEREADONLY
        .lpstrDefExt = pstrExtension
        
        .lpstrFile = pstrCurrentFile
        If GetOpenFileName(ofn) Then
            strFile = Left$(.lpstrFileTitle, InStr(.lpstrFileTitle, vbNullChar) - 1)
            strFile = CurDir & IIf(Right(CurDir, 1) <> &quot;\&quot;, &quot;\&quot;, &quot;&quot;) & strFile
        Else
            strFile = vbNullString
        End If
    End With
    Set frm = Nothing
    
    GetFullFileName = Trim$(strFile)
    
End Function

 

[Aivars]

Thanks and sorry for my English! I did mean not File selection but Folder selection on second view of Folder list, ie.:

1. I open Folder browser first time, select any folder (e.g. C:\Program Files\Microsoft Office), push OK. My textbox updates. OK!

2. I behold that selected folder is wrong, open Folder browser and must start finding of needed folder from Root folders.

??? Is it possibly to open Folder browser's on second time in before selection (in this case - folder C:\Program Files\Microsoft Office)???

Aivars

P.S. But codes for file selection without using of Common Dialog control are very useful because some time Common Dialog control doesn't work on another machine (different library's version number or version date).

 

[jojones]

downwitchyobadself

thanks so much for your code. it is very helpful, however I am not sure how to use the file name code. I tried running it in a sub using:

strfilename = GetFullFileName("C:\&quot

but I get an error 7955 - there is no current Code Context Object

I don't know what a code context object is and am also not sure if I am doing this right.

Can you help?

Cheers
Jo

 

[mulligh]

Could someone please post the code on how to activate the API call from a button in MS Access 2000? I know how to create the module but not how to call it. Thanks!

 

[KornGeek]

downwitchyobadself,
I was looking for code to browse for a file, and thanks to you, I found it and was able to get it up and running within minutes. Here's a star and a tremendous Thank You!