江玉燕与皇上:vb 搜索文件

text1。text=文件夹的路径，
点“运行”按钮，就能自动地把这文件夹（因为此文件夹下的内容别人可以随意修改，所以要求能自动完成）下的所有的.txt文件（不是txt文件就不用复制了）复制到另一个我指定的文件夹下。

代码怎么长啊，看不明白，能不能给个批处理啊。
果只是搜索目录下的文件，代码就简单多了，但要包括多个子文件夹下的所有文件那就简单不了了，其实用VB自带的控件及功能也可以轻松实现，但要搜索海量的文件时效率就不敢恭维了，下面就用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) '要搜索的驱动器/目录
    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