Question

VB6.0中，如何把一个目录下的所有文件的文件名显示到Textbox中？谢谢？

30分悬赏，VB6.0精简版（华军下载）编译通过立刻放分，先答者得。

Answer 1

需要控件text两个、按钮两个，
text2的MultiLine属性为真、Text2.ScrollBars = 2
文件包括子目录里的
如果不想包括
删除
If strTemp <> "." And strTemp <> ".." Then
'It's a normal dir: let's dive straight
'into it...
Call FindFiles(strRootFolder & strTemp, strFolder, strFile, colFilesFound)
End If
这一段

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

Const BIF_RETURNONLYFSDIRS = &H1

Private pidl As Long

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 MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Private 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

Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long

Public Sub FindFiles(strRootFolder As String, strFolder As String, strFile As String, colFilesFound As Collection)
Dim lngSearchHandle As Long
Dim udtFindData As WIN32_FIND_DATA
Dim strTemp As String, lngRet As Long

'Check that folder name ends with "\"
If Right$(strRootFolder, 1) <> "\" Then strRootFolder = strRootFolder & "\"
'Find first file/folder in current folder
lngSearchHandle = FindFirstFile(strRootFolder & "*", udtFindData)
'Check that we received a valid handle
If lngSearchHandle = INVALID_HANDLE_VALUE Then Exit Sub

lngRet = 1
Do While lngRet <> 0
'Trim nulls from filename
strTemp = TrimNulls(udtFindData.cFileName)

If (udtFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
'It's a dir - make sure it isn't . or .. dirs

'删除下面的内容可以不包括子目录
'--------------删除开始
If strTemp <> "." And strTemp <> ".." Then
'It's a normal dir: let's dive straight
'into it...
Call FindFiles(strRootFolder & strTemp, strFolder, strFile, colFilesFound)
End If
'--------------删除结束
Else
'It's a file. First check if the current folder matches
'the folder path in strFolder
If (strRootFolder Like strFolder) Then
'Folder matches, what about file?
If (strTemp Like strFile) Then
'Found one!
colFilesFound.Add strRootFolder & strTemp
End If
End If
End If

'Get next file/folder
lngRet = FindNextFile(lngSearchHandle, udtFindData)
Loop

'Close find handle
Call FindClose(lngSearchHandle)
End Sub

Public Function TrimNulls(strString As String) As String
Dim l As Long

l = InStr(1, strString, Chr(0))
If l = 1 Then
TrimNulls = ""
ElseIf l > 0 Then
TrimNulls = Left$(strString, l - 1)
Else
TrimNulls = strString
End If
End Function

Private Sub Command2_Click()
Dim i As Long
Dim con As New Collection
Dim a() As String
'List1.Visible = False
'List1.Clear
DoEvents
FindFiles Text1.Text, "*", "*.*", con '查找excel文件
Text2.Text = ""
For i = 1 To con.Count
t1 = con.Item(i)
t2 = InStrRev(t1, "\") + 1
t3 = Mid(con.Item(i), t2)
'
Text2.Text = Text2.Text & t3 & vbCrLf
Next

Set con = Nothing

End Sub

Private Sub Command1_Click()
Dim bi As BROWSEINFO
Dim r As Long
Dim pidl As Long
Dim path As String
Dim pos As Integer
'句柄
bi.hOwner = Me.hWnd
'展开根目录
bi.pidlRoot = 0&
'列表框标题
bi.lpszTitle = "请选择路径："
'规定只能选择文件夹，其他无效
bi.ulFlags = BIF_RETURNONLYFSDIRS
'调用API函数显示列表框
pidl = SHBrowseForFolder(bi)
'利用API函数获取返回的路径
path = Space$(512)
r = SHGetPathFromIDList(ByVal pidl&, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
Text1.Text = Left(path, pos - 1)
Else: Text1.Text = ""
End If
End Sub

Private Sub Form_Load()

Text1.Text = App.path

Command1.Caption = "浏览"
Command2.Caption = "整理"
End Sub

'调试完成

追问

神速！谢谢！奉上40分。如果文件名能按第一个单词的首字母顺序排列就更好了。不过这样也可以！

Answer 2

' 查找指定目录下的文件，并显示在TextBox中，
' 需要一个TextBox控件，设置Multline属性=True

Private Sub Command1_Click()
Dim strPathTmp As String, strNameTmp As String
strPathTmp = "D:\"
strNameTmp = Dir(strPathTmp, vbDirectory)
Do While strNameTmp <> ""
If strNameTmp <> "." And strNameTmp <> ".." Then
If GetAttr(strPathTmp & strNameTmp) <> vbDirectory Then
'在strPathTmp目录下找到文件strNameTmp
Text1.text = Text1.text & strNameTmp & Chr(13) + Chr(10)
End If
End If
strNameTmp = Dir
Loop
End Sub

Answer 3

'不需要那么复杂的：
' 需要一个TextBox控件，设置Multline属性=True,ScrollBars属性设置为3
Private Sub Command1_Click()
Dim MyFile As String, strFile As String
strFile = "C:\*.*"
MyFile = Dir(strFile, vbNormal)
Do While MyFile <> ""
If InStr(1, MyFile, StrZf) > 0 Then Text1 = Text1 & Chr(13) & Chr(10) & MyFile
MyFile = Dir
Loop
End Sub

Answer 4

这个有点麻烦，可以把文件名显示到filelistbox控件里，这比较简单的、、、、