您的位置：程序门 -> vb -> 基础类

请问如何用vb遍历一个文件夹下的所有文件包括自文件夹?

[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]

请问如何用vb遍历一个文件夹下的所有文件包括自文件夹?[已结贴,结贴人:bkm2]

发表于：2007-05-06 18:29:23 楼主

请问如何用vb遍历一个文件夹下的所有文件包括自文件夹?

发表于：2007-05-06 19:59:481楼得分:7

'獲取某目錄下的所有子目錄路徑及名稱和檔的路徑及名稱
public sub seachfile（byval strpath as string)
on error resume next
dim fso as object
dim fol as object
dim fil as object
dim disfilename as string

set fso = createobject（ "scripting.filesystemobject ")
set fol = fso.getfolder（strpath)

const deletereadonly = true
if strpath <> " " then
if right（strpath, 1) = "\ " then
strpath = left（strpath, len（strpath) - 1)
end if
label1.caption = strpath

end if

'掃描子目錄
for each fol in fol.subfolders
seachfile fol
next
end sub

发表于：2007-05-06 20:31:242楼得分:3

可以用dir函数,

发表于：2007-05-06 21:54:063楼得分:3

要 "弟龟 "..........................

发表于：2007-05-06 22:23:024楼得分:7

我api和dir都写了，楼住参考一下吧

option explicit
'**********************************************************************************************************************
'搜索api函数、常量、类型等声明
private const invalid_handle_value = -1
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
private declare function findfirstfile lib "kernel32 " alias "findfirstfilea " （byval lpfilename as string, lpfindfiledata as win32_find_data) as long
private wfd as win32_find_data
private type filetime
dwlowdatetime as long
dwhighdatetime as long
end type
private const maxlfnpath = 260
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 * maxlfnpath
cshortfilename as string * 14
end type
'**********************************************************************************************************************
'使listbox滚动条自动下拉等函数及常量声明
public declare function sendmessage lib "user32 " alias "sendmessagea " （byval hwnd as long, byval wmsg as long, byval wparam as long, lparam as any) as long
private const wm_vscroll = &h115
private const sb_bottom = 7
'**********************************************************************************************************************
'发送模拟按键消息
public declare function postmessage lib "user32 " alias "postmessagea " （byval hwnd as long, byval wmsg as long, byval wparam as long, lparam as any) as long
public const bm_click = 245
public declare function messagebox lib "user32 " alias "messageboxa " （byval hwnd as long, byval lptext as string, byval lpcaption as string, byval wtype as long) as long
'**********************************************************************************************************************
'ispause标识是不是处于暂停中,issearch标识是不是处于文件搜索中,isstop是否处于停止状态
public ispause as boolean, issearch as boolean, isstop as boolean

'搜索指定路径并且包括子路径
public sub searcheruserapi（byval strcurpath as string, optional byval ischecksub as boolean = true)
static sum as long
if right（strcurpath, 1) <> "\ " then strcurpath = strcurpath & "\ "
dim dirs as long, dirbuf（) as string, i as integer, hitem as long, k as long, strtmp as string
hitem = findfirstfile（strcurpath & "*.* ", wfd)
if hitem <> invalid_handle_value then
do
if isstop then exit do
sum = sum + 1
if sum mod 20 = 0 then doevents
'检查是不是目录
if （wfd.dwfileattributes and vbdirectory) then
' 检查是不是 ". " or ".. "
if asc（wfd.cfilename) <> 46 then
redim preserve dirbuf（0 to dirs)
dirbuf（dirs) = left（wfd.cfilename, instr（wfd.cfilename, vbnullchar) - 1)
dirs = dirs + 1
strtmp = strcurpath & left（wfd.cfilename, instr（wfd.cfilename, vbnullchar) - 1)
frmmain.lstfolders.additem strtmp
sendmessage frmmain.lstfolders.hwnd, wm_vscroll, sb_bottom, 0&
end if
else
strtmp = strcurpath & left（wfd.cfilename, instr（wfd.cfilename, vbnullchar) - 1)
frmmain.lstfiles.additem strtmp
sendmessage frmmain.lstfiles.hwnd, wm_vscroll, sb_bottom, 0&
end if
loop while findnextfile（hitem, wfd)
call findclose（hitem)
end if
if not ischecksub then exit sub
for i = 0 to dirs - 1
if isstop then exit for
searcheruserapi strcurpath & dirbuf（i) & "\ "
next i
end sub

public sub seacheruserdir（byval strpath as string, optional byval ischecksub as boolean = true)
static sum as long
dim strfolders（) as string, dirs as integer, i as integer
if right（strpath, 1) <> "\ " then strpath = strpath & "\ "
dim strtmp as string
on error resume next
strtmp = dir（strpath & "*.* ", 1 or 2 or 4 or vbdirectory)
do while strtmp <> " "
if isstop then exit do
sum = sum + 1
if sum mod 20 = 0 then doevents
if getattr（strpath & strtmp) and vbdirectory then
if left（strtmp, 1) <> ". " then
frmmain.lstfolders.additem strpath & strtmp
sendmessage frmmain.lstfolders.hwnd, wm_vscroll, sb_bottom, 0&
redim preserve strfolders（0 to dirs)
strfolders（dirs) = strpath & strtmp & "\ "
dirs = dirs + 1
end if
else
frmmain.lstfiles.additem strpath & strtmp
sendmessage frmmain.lstfiles.hwnd, wm_vscroll, sb_bottom, 0&
end if
strtmp = dir
loop
if not ischecksub then exit sub
for i = 0 to dirs - 1
if isstop then exit for
seacheruserdir strfolders（i), ischecksub
next
end sub

public sub restorepublic（)
isstop = false
ispause = false
issearch = false
end sub

发表于：2007-05-06 22:53:255楼得分:0

ding

————————————————————————————————————
写作，虽然每个人都会查阅辞海，可，不是人人都能写出不朽的篇章的。编程，如是也。

发表于：2007-05-07 10:05:496楼得分:0

弄个函数给你 sfoldersearch参数是要搜索的文件夹的路径
private sub search（sfoldersearch as folder)
dim sfolder as folder
dim sfile as file

'搜索文件夹中的文件
for each sfile in sfoldersearch.files
'一些相关操作
next
'搜索文件夹中的子文件夹
for each sfolder in sfoldersearch.subfolders
call search（sfolder) '递归
next
'可以一直搜索到最底层

end sub

发表于：2007-05-07 11:49:227楼得分:0

'a very good reference for bkm2 （bkm2) about topic "请问如何用vb遍历一个文件夹下的所有文件包括自文件夹? " -- cheers!!!

private sub form_load（)
on error goto hell

dim ssearchpath as string, sextensionlist as string
dim tafiles as mctfilesearchresults
dim x as long

me.show
doevents
screen.mousepointer = vbhourglass

ssearchpath = "c:\windows\system32 "
sextensionlist = "*.* " ' "*.txt;*.exe "

filesearcha ssearchpath, sextensionlist, tafiles, false

if tafiles.filecount > 0 then
with listview
.view = lvwreport
.move 60, 60, 10995, 3435
with .columnheaders
.add , , "filename ", 1560
.add , , "extension ", 900
.add , , "path ", 1904
.add , , "size ", 989
.add , , "read-only ", 945
.add , , "unc path ", 2910
.add , , "creation date ", 1440
end with
me.move me.left, me.top, .width + 240, .height + 520
end with

for x = 1 to ubound（tafiles.files)
with listview.listitems.add（, , tafiles.files（x).filename)
.subitems（1) = tafiles.files（x).extension
.subitems（2) = tafiles.files（x).filepath
.subitems（3) = formatnumber（tafiles.files（x).size, 0)
.subitems（4) = iif（tafiles.files（x).readonly, "yes ", " ")
.subitems（5) = tafiles.files（x).unc
.subitems（6) = tafiles.files（x).creationdate
end with
next
with listview.listitems.add（, , "totals ")
.subitems（5) = tafiles.filecount & " files "
.subitems（3) = format$（tafiles.filesize, "###,###,###,##0 ") & " bytes "
end with
end if
screen.mousepointer = vbdefault

exit sub
hell:
debug.print err.description: stop: resume
end sub

发表于：2007-05-07 11:49:418楼得分:0

'a bas file
public type mctfileinfotype
filepath as string
filename as string
unc as string
extension as string
size as currency
readonly as boolean
creationdate as string
end type

public type mctfilesearchresults
filecount as long
filesize as currency
files（) as mctfileinfotype
end type

private const max_path = 260
private const maxdword = &hffff
private const invalid_handle_value = -1
private const file_attribute_archive = &h20
private const file_attribute_directory = &h10
private const file_attribute_hidden = &h2
private const file_attribute_normal = &h80
private const file_attribute_readonly = &h1
private const file_attribute_system = &h4
private const file_attribute_temporary = &h100

private type filetime
dwlowdatetime as long
dwhighdatetime as long
end type

private type systemtime
wyear as integer
wmonth as integer
wdayofweek as integer
wday as integer
whour as integer
wminute as integer
wsecond as integer
wmilliseconds as integer
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
private declare function filetimetosystemtime lib "kernel32 " （lpfiletime as filetime, lpsystemtime as systemtime) as long

private function getfilesize_（byval ifilesizehigh as long, byval ifilesizelow as long) as currency

dim curfilesizehigh as currency
dim curfilesizelow as currency
dim curfilesize as currency

curfilesizehigh = ccur（ifilesizehigh)
curfilesizelow = ccur（ifilesizelow)

curfilesize = curfilesizelow

if curfilesizelow < 0 then
curfilesize = curfilesize + 4294967296@
end if

if curfilesizehigh > 0 then
curfilesize = curfilesize + （curfilesizehigh * 4294967296@)
end if

getfilesize_ = curfilesize

end function
public sub filesearcha（byval spath as string, byval sfilemask as string, byref tafiles as mctfilesearchresults, _
optional byval brecursive as boolean = false, optional byval irecursionlevel as long = -1)
on error goto hell

dim sfilename as string
dim sfolder as string
dim ifoldercount as long
dim afolders（) as string
dim afilemask（) as string
dim isearchhandle as long
dim wfd as win32_find_data
dim bcontinue as long: bcontinue = true
dim ret as long, x as long
dim tsystemtime as systemtime

if right（spath, 1) <> "\ " then spath = spath & "\ "

' search for subdirectories first and save 'em for later
' --------------------------
if brecursive then
isearchhandle = findfirstfile（spath & "*. ", wfd)

if isearchhandle <> invalid_handle_value then
do while bcontinue

if （instr（wfd.cfilename, chr（0)) > 0) then wfd.cfilename = left（wfd.cfilename, instr（wfd.cfilename, chr（0)) - 1)
sfolder = trim$（wfd.cfilename)

if （sfolder <> ". ") and （sfolder <> ".. ") then ' ignore the current and encompassing directories
if wfd.dwfileattributes and vbdirectory then
ifoldercount = ifoldercount + 1
redim preserve afolders（ifoldercount)
afolders（ifoldercount) = sfolder
end if
end if

bcontinue = findnextfile（isearchhandle, wfd) 'get next subdirectory.

loop
bcontinue = findclose（isearchhandle)
end if
end if
' --------------------------

bcontinue = true

' walk through this directory and sum file sizes.
' --------------------------

' findfirstfile takes one type at a time, so we 'll loop the search for as many extensions as specified
afilemask = split（sfilemask, "; ")
for x = 0 to ubound（afilemask)

' make sure it 's all formatted
if left$（afilemask（x), 1) = ". " then
afilemask（x) = "* " & afilemask（x)
elseif left$（afilemask（x), 2) <> "*. " then
afilemask（x) = "*. " & afilemask（x)
end if

isearchhandle = findfirstfile（spath & afilemask（x), wfd)

if isearchhandle <> invalid_handle_value then
do while bcontinue

if （instr（wfd.cfilename, chr（0)) > 0) then wfd.cfilename = left（wfd.cfilename, instr（wfd.cfilename, chr（0)) - 1)
sfilename = trim$（wfd.cfilename)

' it 's a file, right?
if （sfilename <> ". ") and （sfilename <> ".. ") and （not （wfd.dwfileattributes and vbdirectory) = vbdirectory) then
with tafiles
.filesize = .filesize + getfilesize_（wfd.nfilesizehigh, wfd.nfilesizelow)
.filecount = .filecount + 1
redim preserve .files（.filecount)
with .files（.filecount)
.extension = mid$（sfilename, instrrev（sfilename, ". ") + 1)
.filename = sfilename
.filepath = spath
.readonly = （wfd.dwfileattributes and vbreadonly) = vbreadonly
.size = getfilesize_（wfd.nfilesizehigh, wfd.nfilesizelow)
.unc = spath & sfilename
if filetimetosystemtime（wfd.ftcreationtime, tsystemtime) then .creationdate = tsystemtime.wmonth & "/ " & tsystemtime.wday & "/ " & tsystemtime.wyear & " " & iif（tsystemtime.whour > 12, tsystemtime.whour - 12 & ": " & tsystemtime.wminute & " pm ", tsystemtime.whour & ": " & tsystemtime.wminute & " am ")
end with
end with
end if
bcontinue = findnextfile（isearchhandle, wfd) ' get next file
loop
bcontinue = findclose（isearchhandle)
end if
next
' --------------------------

' if there are sub-directories,
if ifoldercount > 0 then
' and if we care,
if brecursive then
if irecursionlevel <> 0 then ' recursively walk into them...
irecursionlevel = irecursionlevel - 1
for x = 1 to ifoldercount
filesearcha spath & afolders（x) & "\ ", sfilemask, tafiles, brecursive, irecursionlevel
next x
end if
end if
end if

' --------------------------------------------------------------------------
exit sub
hell:
debug.print err.description: stop: resume
end sub

private function getfilesize_（byval ifilesizehigh as currency, byval ifilesizelow as currency) as currency

getfilesize_ = ifilesizelow
if ifilesizelow < 0 then getfilesize_ = getfilesize_ + 4294967296@
if ifilesizehigh > 0 then getfilesize_ = getfilesize_ + （ifilesizehigh * 4294967296@)

end function

发表于：2007-05-07 11:50:489楼得分:0

good luck,new babier!

发表于：2007-05-07 12:17:0510楼得分:0

mark

下一篇：100分求助：求两条线交点问题
上一篇：如何向指定的窗体（无论前台后台最小化)发送按键消息

相关文章

其他资讯

快速检索

分类导航标签a

最新资讯

热门点击