vb 文件搜索 50
想让程序能自动在某个指定的目录里搜索一些指定名字的文件例如在E:\里搜索叫1.txt的文件而且要搜索子目录整个E:\可能有多个1.txt把他们的路径都列出来...有办法吗...
想让程序 能自动 在某个指定的目录里搜索 一些指定名字的文件
例如 在E:\里 搜索叫1.txt的文件 而且 要搜索子目录
整个E:\可能有多个 1.txt 把他们 的 路径都 列出来...
有办法吗?
修改一下..
只需要 搜索当前的文件夹里有没有这个文件
例如 E:\ 有 123 124 125 3个文件夹
搜索这3个里面有没有 1.txt 不需要 再往下级目录搜索 展开
例如 在E:\里 搜索叫1.txt的文件 而且 要搜索子目录
整个E:\可能有多个 1.txt 把他们 的 路径都 列出来...
有办法吗?
修改一下..
只需要 搜索当前的文件夹里有没有这个文件
例如 E:\ 有 123 124 125 3个文件夹
搜索这3个里面有没有 1.txt 不需要 再往下级目录搜索 展开
3个回答
展开全部
新建一个标准EXE工程,加载一个ListBox;两个CommandButton;两个TextBox;及一个PictureBox控件,然后贴上以下代码:
Option Explicit
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const DT_NOPREFIX As Long = 2048
Private Const DT_PATH_ELLIPSIS As Long = &H4000
Private Const DT_WORDBREAK As Long = &H10
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom 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 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
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function DrawText Lib "USER32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private m_bCancel As Boolean
Private m_sFind As String
Private m_lFilesFound As Long
Private m_DestinationFile As String
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Sub Form_Load()
Command1.Caption = "开始搜索文件..."
Command2.Caption = "停止搜索"
End Sub
Private Sub Command1_Click()
Dim mPath As String
Dim v As Long
If Trim(Text1.Text) = "" Then Exit Sub
mPath = Trim(Text1.Text) '要搜索的驱动器/目录
If Right(mPath, 1) <> "\" Then
mPath = mPath & "\"
End If
m_sFind = "*.Txt" '指定要搜索的文件类型可以设置(*.*),如果要搜索多种类型,就要用Split函数处理成数组。
m_bCancel = False
List1.Clear '如果不用ListBox显示结果,速度还会快一点。
If Trim(Text2.Text) = "" Then Exit Sub
m_DestinationFile = Trim(Text2.Text) '要拷贝的目标驱动器/目录
If Right(m_DestinationFile, 1) <> "\" Then
m_DestinationFile = m_DestinationFile & "\"
End If
m_lFilesFound = 0
v = GetDriveType(m_DestinationFile)
Select Case v
Case 0 '不能识别的驱动器
MsgBox "不能识别指定要复制文件的目标驱动器!", vbCritical, "提示"
Case 1 '指定的目录不存
MsgBox "指定要复制文件的目标路径不正确!", vbCritical, "提示"
Case DRIVE_REMOVABLE
Case DRIVE_FIXED
Call SearchFolders(mPath)
Case DRIVE_REMOTE
Case DRIVE_CDROM
MsgBox "不能向光盘驱动器拷贝文件!", vbCritical, "提示"
Case DRIVE_RAMDISK
End Select
Call UpdateStatus("搜索符合(" & m_sFind & ")条的文件共:" & CStr(m_lFilesFound) & " 个")
End Sub
Private Sub Command2_Click()
m_bCancel = True '停止搜索
End Sub
Private Sub SearchFolders(ByRef sFolder As String)
Dim hFind As Long
Dim uFind As WIN32_FIND_DATA
Dim lFiles As Long
hFind = FindFirstFile(sFolder & "*.*", uFind)
If hFind <> INVALID_HANDLE_VALUE Then
UpdateStatus "Searching -> " & sFolder '显示搜索状态
DoEvents
If Not m_bCancel Then
lFiles = SearchFiles(sFolder)
Do
If uFind.dwFileAttributes And vbDirectory Then
If AscW(uFind.cFileName) <> 46 Then
SearchFolders sFolder & Left$(uFind.cFileName, InStr(uFind.cFileName, vbNullChar) - 1) & "\"
End If
End If
Loop Until FindNextFile(hFind, uFind) = 0
End If
FindClose hFind
End If
End Sub
Private Function SearchFiles(ByRef sFolder As String) As Long
Dim hFind As Long
Dim uFind As WIN32_FIND_DATA
Dim sFile As String
Dim uLocalTime As FILETIME
Dim uSysTime As SYSTEMTIME
Dim dtDate As Date
hFind = FindFirstFile(sFolder & m_sFind, uFind)
If hFind <> INVALID_HANDLE_VALUE Then
Do
If Not (uFind.dwFileAttributes And vbDirectory) Or (AscW(uFind.cFileName) = 46) Then
sFile = Left$(uFind.cFileName, InStr(uFind.cFileName, vbNullChar) - 1)
FileTimeToLocalFileTime uFind.ftLastWriteTime, uLocalTime
If FileTimeToSystemTime(uLocalTime, uSysTime) = 0 Then
List1.AddItem sFile
Else
With uSysTime '获取文件修改时间
dtDate = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond)
End With
'显示搜索内容
List1.AddItem sFolder & sFile '& vbTab & CStr(dtDate)
Call FileCopy(sFolder & sFile, m_DestinationFile & sFile) '拷贝文件
End If
m_lFilesFound = m_lFilesFound + 1
End If
Loop Until FindNextFile(hFind, uFind) = 0
FindClose hFind
End If
End Function
Private Sub UpdateStatus(ByRef sStatus As String)
Dim uRect As RECT
Picture1.Cls
If LenB(sStatus) <> 0 Then
uRect.Right = Picture1.Width - 1
uRect.Bottom = Picture1.Height - 1
DrawText Picture1.hDC, sStatus, -1, uRect, DT_PATH_ELLIPSIS Or DT_NOPREFIX Or DT_WORDBREAK
End If
End Sub
另外补充一下:
# 由于只是例子,只在Form模块下编写,正确的写法最好是建一个模块把API、常量及函数过程定义在模块中。
# 利用以上的遍历方法,还可以根据数据类型WIN32_FIND_DATA 的 dwFileAttributes、ftCreationTime、ftLastAccessTime、ftLastWriteTime 各元素来扩充文件查询功能(按文件属性、创建日期、最后修改日期、最后访问日期等不同条件的搜索)。
==========================================================
呵呵,代码是长了点,但这是高级高效率代码,您看不明白这不是您的错,这也证明了百度里并不是没有高手,而是你太低了!
用批处理(bat)太弱智了俺写不出手,就直接用cmd 随便搞搞吧:
Private Sub Command1_Click()
Dim mSource As String '源路径
Dim mDestination As String '目标路径
mSource = Trim(Text1.Text)
If mSource = "" Then Exit Sub
If Right(mSource, 1) <> "\" Then mSource = mSource & "\"
mSource = mSource & "*.txt"
mDestination = Trim(Text2.Text)
If mDestination = "" Then Exit Sub
If Right(mDestination, 1) <> "\" Then mDestination = mDestination & "\"
Shell "cmd /c xcopy " & mSource & " /s/y " & mDestination, vbNormalFocus
End Sub
Option Explicit
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const DT_NOPREFIX As Long = 2048
Private Const DT_PATH_ELLIPSIS As Long = &H4000
Private Const DT_WORDBREAK As Long = &H10
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom 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 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
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function DrawText Lib "USER32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private m_bCancel As Boolean
Private m_sFind As String
Private m_lFilesFound As Long
Private m_DestinationFile As String
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
Private Sub Form_Load()
Command1.Caption = "开始搜索文件..."
Command2.Caption = "停止搜索"
End Sub
Private Sub Command1_Click()
Dim mPath As String
Dim v As Long
If Trim(Text1.Text) = "" Then Exit Sub
mPath = Trim(Text1.Text) '要搜索的驱动器/目录
If Right(mPath, 1) <> "\" Then
mPath = mPath & "\"
End If
m_sFind = "*.Txt" '指定要搜索的文件类型可以设置(*.*),如果要搜索多种类型,就要用Split函数处理成数组。
m_bCancel = False
List1.Clear '如果不用ListBox显示结果,速度还会快一点。
If Trim(Text2.Text) = "" Then Exit Sub
m_DestinationFile = Trim(Text2.Text) '要拷贝的目标驱动器/目录
If Right(m_DestinationFile, 1) <> "\" Then
m_DestinationFile = m_DestinationFile & "\"
End If
m_lFilesFound = 0
v = GetDriveType(m_DestinationFile)
Select Case v
Case 0 '不能识别的驱动器
MsgBox "不能识别指定要复制文件的目标驱动器!", vbCritical, "提示"
Case 1 '指定的目录不存
MsgBox "指定要复制文件的目标路径不正确!", vbCritical, "提示"
Case DRIVE_REMOVABLE
Case DRIVE_FIXED
Call SearchFolders(mPath)
Case DRIVE_REMOTE
Case DRIVE_CDROM
MsgBox "不能向光盘驱动器拷贝文件!", vbCritical, "提示"
Case DRIVE_RAMDISK
End Select
Call UpdateStatus("搜索符合(" & m_sFind & ")条的文件共:" & CStr(m_lFilesFound) & " 个")
End Sub
Private Sub Command2_Click()
m_bCancel = True '停止搜索
End Sub
Private Sub SearchFolders(ByRef sFolder As String)
Dim hFind As Long
Dim uFind As WIN32_FIND_DATA
Dim lFiles As Long
hFind = FindFirstFile(sFolder & "*.*", uFind)
If hFind <> INVALID_HANDLE_VALUE Then
UpdateStatus "Searching -> " & sFolder '显示搜索状态
DoEvents
If Not m_bCancel Then
lFiles = SearchFiles(sFolder)
Do
If uFind.dwFileAttributes And vbDirectory Then
If AscW(uFind.cFileName) <> 46 Then
SearchFolders sFolder & Left$(uFind.cFileName, InStr(uFind.cFileName, vbNullChar) - 1) & "\"
End If
End If
Loop Until FindNextFile(hFind, uFind) = 0
End If
FindClose hFind
End If
End Sub
Private Function SearchFiles(ByRef sFolder As String) As Long
Dim hFind As Long
Dim uFind As WIN32_FIND_DATA
Dim sFile As String
Dim uLocalTime As FILETIME
Dim uSysTime As SYSTEMTIME
Dim dtDate As Date
hFind = FindFirstFile(sFolder & m_sFind, uFind)
If hFind <> INVALID_HANDLE_VALUE Then
Do
If Not (uFind.dwFileAttributes And vbDirectory) Or (AscW(uFind.cFileName) = 46) Then
sFile = Left$(uFind.cFileName, InStr(uFind.cFileName, vbNullChar) - 1)
FileTimeToLocalFileTime uFind.ftLastWriteTime, uLocalTime
If FileTimeToSystemTime(uLocalTime, uSysTime) = 0 Then
List1.AddItem sFile
Else
With uSysTime '获取文件修改时间
dtDate = DateSerial(.wYear, .wMonth, .wDay) + TimeSerial(.wHour, .wMinute, .wSecond)
End With
'显示搜索内容
List1.AddItem sFolder & sFile '& vbTab & CStr(dtDate)
Call FileCopy(sFolder & sFile, m_DestinationFile & sFile) '拷贝文件
End If
m_lFilesFound = m_lFilesFound + 1
End If
Loop Until FindNextFile(hFind, uFind) = 0
FindClose hFind
End If
End Function
Private Sub UpdateStatus(ByRef sStatus As String)
Dim uRect As RECT
Picture1.Cls
If LenB(sStatus) <> 0 Then
uRect.Right = Picture1.Width - 1
uRect.Bottom = Picture1.Height - 1
DrawText Picture1.hDC, sStatus, -1, uRect, DT_PATH_ELLIPSIS Or DT_NOPREFIX Or DT_WORDBREAK
End If
End Sub
另外补充一下:
# 由于只是例子,只在Form模块下编写,正确的写法最好是建一个模块把API、常量及函数过程定义在模块中。
# 利用以上的遍历方法,还可以根据数据类型WIN32_FIND_DATA 的 dwFileAttributes、ftCreationTime、ftLastAccessTime、ftLastWriteTime 各元素来扩充文件查询功能(按文件属性、创建日期、最后修改日期、最后访问日期等不同条件的搜索)。
==========================================================
呵呵,代码是长了点,但这是高级高效率代码,您看不明白这不是您的错,这也证明了百度里并不是没有高手,而是你太低了!
用批处理(bat)太弱智了俺写不出手,就直接用cmd 随便搞搞吧:
Private Sub Command1_Click()
Dim mSource As String '源路径
Dim mDestination As String '目标路径
mSource = Trim(Text1.Text)
If mSource = "" Then Exit Sub
If Right(mSource, 1) <> "\" Then mSource = mSource & "\"
mSource = mSource & "*.txt"
mDestination = Trim(Text2.Text)
If mDestination = "" Then Exit Sub
If Right(mDestination, 1) <> "\" Then mDestination = mDestination & "\"
Shell "cmd /c xcopy " & mSource & " /s/y " & mDestination, vbNormalFocus
End Sub
展开全部
f1="e:\123\1.txt"
if dir(f,vbReadOnly + vbHidden + vbNormal + vbArchive)<>"" then
print f & "不存在"
else
print f & "存在"
end if
其他一样
if dir(f,vbReadOnly + vbHidden + vbNormal + vbArchive)<>"" then
print f & "不存在"
else
print f & "存在"
end if
其他一样
本回答被网友采纳
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
fso 枚举,不停向下层搜
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询