VB:统计一个文件夹中的所有文件名(包括子文件夹中的文件名)到Textbox1中,文件名为完整的路径.
4个回答
展开全部
'text1设置成多行
Dim fso As Object
Private Sub Command1_Click()
Dim path As String, p
Text1 = ""
path = "d:\abc"
path = IIf(Right(path, 1) = "\", Left(path, Len(path) - 1), path) '目录格式统一
If fso.FolderExists(path) = True Then getsubfolderfils (path)
End Sub
Private Sub Form_Load()
Set fso = CreateObject("Scripting.FileSystemObject")
End Sub
Function getsubfolderfils(path As String)
Dim p, f, s As String
On Error Resume Next'自己处理,有些目录的权限是system的,所以无法访问
For Each f In fso.GetFolder(path).Files
Text1 = Text1 & path & "\" & f.name & vbNewLine '目录或文件很多时候用一个数组获取文件名,最后再写入text
Next
For Each p In fso.GetFolder(path).subfolders
getsubfolderfils path & "\" & p.name
Next
End Function
Dim fso As Object
Private Sub Command1_Click()
Dim path As String, p
Text1 = ""
path = "d:\abc"
path = IIf(Right(path, 1) = "\", Left(path, Len(path) - 1), path) '目录格式统一
If fso.FolderExists(path) = True Then getsubfolderfils (path)
End Sub
Private Sub Form_Load()
Set fso = CreateObject("Scripting.FileSystemObject")
End Sub
Function getsubfolderfils(path As String)
Dim p, f, s As String
On Error Resume Next'自己处理,有些目录的权限是system的,所以无法访问
For Each f In fso.GetFolder(path).Files
Text1 = Text1 & path & "\" & f.name & vbNewLine '目录或文件很多时候用一个数组获取文件名,最后再写入text
Next
For Each p In fso.GetFolder(path).subfolders
getsubfolderfils path & "\" & p.name
Next
End Function
展开全部
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
'示例: 添加一按钮和一textbox
Private Sub Command1_Click()
Dim i As Long
Dim con As New Collection
Text1.Text = ""
DoEvents
FindFiles "c:\windows\system32", "*", "*.*", con '查找c:\windows\system32文件夹中的所有文件
For i = 1 To con.Count
Text1.Text = Text1.Text & con.Item(i) & vbCrLf
Next
Set con = Nothing
End Sub
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
'示例: 添加一按钮和一textbox
Private Sub Command1_Click()
Dim i As Long
Dim con As New Collection
Text1.Text = ""
DoEvents
FindFiles "c:\windows\system32", "*", "*.*", con '查找c:\windows\system32文件夹中的所有文件
For i = 1 To con.Count
Text1.Text = Text1.Text & con.Item(i) & vbCrLf
Next
Set con = Nothing
End Sub
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
那要看你的Textbox1是不是多行显示的
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询