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

VB6.0中,如何把一个目录下的所有文件的文件名显示到Textbox中?谢谢?,第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

'调试完成

Private Sub Command1_Click()

Dim filename As String

filename = App.Path &"\" &Text1 &".txt" '创建的文件格式.

If Dir(filename) = "" Then '判断搭帆姿文件是否存在,不存在就创建,存在就不创建轿枣

Open filename For Append As #1

Close #1

MsgBox "创建成功。", vbInformation, "成功。"

Else

MsgBox "文件已存在.", vbInformation, "已知绝存在在文件."

End If

End Sub

添加一个Dirlistbox,Textbox,一个按钮,一个组合框...

按钮的单击事件如下

Private Sub Command1_Click()

Dim i As Integer

Dim b As Integer

Dim a As String

a = Text1.Text

Dir1.Path = a

b = Len(a)

Combo1.Clear

For i = 0 To Dir1.ListCount - 1

Combo1.AddItem (Mid(Dir1.List(i), b + 1))

Next

End Sub

运行时候,在TextBox里输入文件路径,如 C:\windows\ 这里路径后面把"\"要加上,然后,单击按钮,再查看组合框,就可以看到windows目录下了。。。

以上程序在我的机子(XP,SP2版,VB6.0企业版)上测试通过


欢迎分享,转载请注明来源:内存溢出

原文地址: https://outofmemory.cn/bake/11975599.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-20
下一篇 2023-05-20

发表评论

登录后才能评论

评论列表(0条)

保存