Solved

Dir files to list box

Posted on 1998-06-21
7
219 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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
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

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
When designing a form there are several BorderStyles to choose from, all of which can be classified as either 'Fixed' or 'Sizable' and I'd guess that 'Fixed Single' or one of the other fixed types is the most popular choice. I assume it's the most p…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

706 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now