Solved

Dir files to list box

Posted on 1998-06-21
7
226 Views
Last Modified: 2009-07-29
I dont want to use Dir control.
I want to, given a pathname, push a command button that would fill a list box with the contents of that pathnames directory's only.  If the command is pushed again
the list box must be emptied and re-updated with the
then current directory names in that pathname.

Thanks Experts.





0
Comment
Question by:vern12
  • 3
  • 3
7 Comments
 
LVL 5

Expert Comment

by:dirtdart
ID: 1463878
Public Const MAX_PATH = 260

Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long

Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long

Dim hFile As Long
Dim ret As Long
Dim wfd As WIN32_FIND_DATA
Dim sPath As String

If List1.ListCount > 0 Then List1.Clear 'Clear the list of any contents

sPath = Text1.Text 'Find the requested directory
If Right(sPath, 1) <> "\" Then sPath = sPath & "\*.*" 'Append it for pattern matching
   
hFile = FindFirstFile(sPath, wfd) 'Get the handle to the first matching file

If hFile <> 0 Then List1.AddItem wfd.cFileName 'If the handle is 0 then an error occurred

ret = 1

Do While ret <> 0 'When ret = 0 then there are no more matching filenames

ret = FindNextFile(hFile, wfd) 'Find the next matching file
If ret <> 0 Then List1.AddItem wfd.cFileName 'Add it to the list

Loop

End Sub

0
 
LVL 4

Expert Comment

by:yowkee
ID: 1463879
There is simpler way:

---
Private Declare Function SendMessageStr Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
Private Const LB_DIR = &H18D
Private Const DDL_READWRITE = &H0
Private Const DDL_SYSTEM = &H4
Private Const DDL_ARCHIVE = &H20

Private Sub Command1_Click()
    FillList "C:\windows"     ' Fill listbox List1 with files in
                              ' C:\windows    
End Sub

Private Sub FillList(ByVal pstrDir As String)
    Dim sCurrPath As String
    sCurrPath = CurDir
    ChDir pstrDir        ' Change to the required directory
    List1.Clear
    SendMessageStr List1.hwnd, LB_DIR, _
                DDL_ARCHIVE Or DDL_READWRITE Or DDL_SYSTEM, _
                "*.*"
    ChDir sCurrPath      ' Change back to save directory
End Sub
0
 

Author Comment

by:vern12
ID: 1463880
Dirtdart, I could not get your example to work
no errors, just an empty list box.
 
Yowkee, Your example works, except I see no directorys only
files in the list box, I want only the directory and folder
names to appear in the box, if you have this solution
please post an answer.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 4

Accepted Solution

by:
yowkee earned 50 total points
ID: 1463881
vern12,

  If you only want directory under required path being show out, pass 'DDL_DIRECTORY Or DDL_EXCLUSIVE' to replace 'DDL_ARCHIVE Or DDL_READWRITE Or DDL_SYSTEM' at 3rd parameter of SendMessageStr.

---
Private Const DDL_DIRECTORY = &H10
Private Const DDL_EXCLUSIVE = &H8000
:
:   ' All as above
:
' change this line
    SendMessageStr List1.hwnd, LB_DIR, _
                DDL_DIRECTORY Or DDL_EXCLUSIVE, _
                "*"
:
:
-----

Regards.
 
0
 

Author Comment

by:vern12
ID: 1463882
The directory names look like [examp~1]
how can i get the full dir name: example , without []
0
 
LVL 4

Expert Comment

by:yowkee
ID: 1463883
vern12,

  The '[]' is added by sendmessage method by default. If you sure don't want the '[]' to be displayed, I would provide another example which do the same thing but with more codes. Here's the example with APIs FindFirstFile and FindNextFile:

--- ' I put following code in a BAS module
Public Const MAX_PATH = 260
 
'GetDriveType return values
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6
Public Const LB_ADDSTRING = &H180

Type FILETIME
 dwLowDateTime As Long
 dwHighDateTime As Long
End Type

Type WIN32_FIND_DATA
 dwFileAttributes As Long
 ftCreationTime As FILETIME
 ftLastAccessTime As FILETIME
 ftLastWriteTime As FILETIME
 nFileSizeHigh As Long
 nFileSizeLow As Long
 dwReserved0 As Long
 dwReserved1 As Long
 cFileName As String * MAX_PATH
 cAlternate As String * 14
End Type

Public Declare Function FindFirstFile _
Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
 lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindNextFile _
    Lib "kernel32" Alias "FindNextFileA" _
    (ByVal hFindFile As Long, _
     lpFindFileData As WIN32_FIND_DATA) As Long

Public Declare Function FindClose _
  Lib "kernel32" (ByVal hFindFile As Long) As Long
 
Declare Function SendMessageStr Lib "user32" _
 Alias "SendMessageA" _
 (ByVal hwnd As Long, ByVal wMsg As Long, _
  ByVal wParam As Long, ByVal lParam As String) As Long
 
Public Function TrimNull(startstr As String) As String

  Dim pos As Integer
  pos = InStr(startstr, Chr$(0))
  If pos Then
      TrimNull = Left$(startstr, pos - 1)
      Exit Function
  End If
 
 'if this far, there was no Chr$(0), so return the string
  TrimNull = startstr
 
End Function


Public Sub FillListWithFolders(lstView As ListBox, ByVal pstrPath As String)
 
    Dim WFD As WIN32_FIND_DATA
    Dim hFile As Long
   
    Dim sFile As String
     
    Dim i As Integer
    Dim r As Long
    Dim found As Integer
 
    'find the first file matching the parameter \*.*
    If Right$(pstrPath, 1) = "\" Then
        hFile = FindFirstFile(pstrPath & "*.*" & Chr$(0), WFD)
    Else
        hFile = FindFirstFile(pstrPath & "\*.*" & Chr$(0), WFD)
    End If

    If hFile - 1 Then
        sFile = TrimNull(WFD.cFileName)
        WFD.dwFileAttributes = vbDirectory

        While FindNextFile(hFile, WFD)
            sFile = TrimNull(WFD.cFileName)
            'ignore the 2 standard root entries
            If (sFile <> ".") And (sFile <> "..") Then
                 If (WFD.dwFileAttributes And vbDirectory) Then
                  SendMessageStr lstView.hwnd, LB_ADDSTRING, 0, _
                                 WFD.cFileName
                 End If
            End If
        Wend
    End If
 
    r = FindClose(hFile)
     
End Sub

--------- ' Code in Form module, which has one button and listbox

Private Sub Command1_Click()
    FillListWithFolders List1, "C:\windows"
End Sub

--------

Regards.
0
 

Author Comment

by:vern12
ID: 1463884
yeppee.
Thanks yowkee
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

756 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question