text1。text=文件夾的路徑，
點“運行”按鈕，就能自動地把這文件夾（因為此文件夾下的內(nèi)容別人可以隨意修改，所以要求能自動完成）下的所有的.txt文件（不是txt文件就不用復(fù)制了）復(fù)制到另一個我指定的文件夾下。
代碼怎么長啊，看不明白，能不能給個批處理啊。
果只是搜索目錄下的文件，代碼就簡單多了，但要包括多個子文件夾下的所有文件那就簡單不了了，其實用VB自帶的控件及功能也可以輕松實現(xiàn)，但要搜索海量的文件時效率就不敢恭維了，下面就用API方式極速遍歷多重目錄下的文件(Windows的搜索功能及很多殺毒軟件就是用類似的方法遍歷文件的)。
新建一個標準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) '要搜索的驅(qū)動器/目錄
If Right(mPath, 1) <> "\" Then
mPath = mPath & "\"
End If
m_sFind = "*.Txt" '指定要搜索的文件類型可以設(shè)置(*.*)，如果要搜索多種類型，就要用Split函數(shù)處理成數(shù)組。
m_bCancel = False
List1.Clear '如果不用ListBox顯示結(jié)果，速度還會快一點。
If Trim(Text2.Text) = "" Then Exit Sub
m_DestinationFile = Trim(Text2.Text) '要拷貝的目標驅(qū)動器/目錄
If Right(m_DestinationFile, 1) <> "\" Then
m_DestinationFile = m_DestinationFile & "\"
End If
m_lFilesFound = 0
v = GetDriveType(m_DestinationFile)
Select Case v
Case 0 '不能識別的驅(qū)動器
MsgBox "不能識別指定要復(fù)制文件的目標驅(qū)動器！", vbCritical, "提示"
Case 1 '指定的目錄不存
MsgBox "指定要復(fù)制文件的目標路徑不正確！", vbCritical, "提示"
Case DRIVE_REMOVABLE
Case DRIVE_FIXED
Call SearchFolders(mPath)
Case DRIVE_REMOTE
Case DRIVE_CDROM
MsgBox "不能向光盤驅(qū)動器拷貝文件！", 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 '顯示搜索狀態(tài)
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
'顯示搜索內(nèi)容
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、常量及函數(shù)過程定義在模塊中。
# 利用以上的遍歷方法，還可以根據(jù)數(shù)據(jù)類型WIN32_FIND_DATA 的 dwFileAttributes、ftCreationTime、ftLastAccessTime、ftLastWriteTime 各元素來擴充文件查詢功能（按文件屬性、創(chuàng)建日期、最后修改日期、最后訪問日期等不同條件的搜索）。
==========================================================
呵呵，代碼是長了點，但這是高級高效率代碼，您看不明白這不是您的錯，這也證明了百度里并不是沒有高手，而是你太低了！
用批處理(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
本站僅提供存儲服務(wù)，所有內(nèi)容均由用戶發(fā)布，如發(fā)現(xiàn)有害或侵權(quán)內(nèi)容，請
點擊舉報。
