fieldset{padding:10px;}
vba查找文件的问题我需要做一个查找指定目录下的相关文件功能指定目录（folder）由人为输入相关文件名（fileName）也由人为输入，特别注意，fileName需要可以包含通配符如：*,?以下是我自己实现的一段代码 Dim fs As FileSearch Set fs = Application.FileSearch With fs .LookIn = folder .Filename = fileName .SearchSubFolders = True If .Execute(msoSortByFileName, msoSortOrderAscending) > 0 Then For i = 1 To .FoundFiles.Count Cells(i, 1) = .FoundFiles(i) Next End If End With不过这段代码有点小问题，①当fileName="a*.*"的时候能正常查出文件名第一个字母为a的所有文件②但是当fileName="a*.java"的时候就不能正常查出文件名第一个字母为a的所有文件了，这时查出的是所有文件名包含a的文件，不止单单是第一个字母为a能查出，第二、三个字母为a都会被查出来，如同是在查找"*a*.java"一样③我继续试验下去，发现当查找fileName="a*.ja"时，和②时的结果一样，试验了多次发现其实实际的查找效果如同是在这个字符串的头尾都默认加了个"*"通配符在查找一样，查"a*.java"其实就是在查"*a*.java*"④我查找"a*.java;a*.txt"，本意是查找第一个字母为a的java和txt文件，可是也和③一样，实际查找的结果是含有a的java文件和第一个字母为a的txt文件，即"*a*.java;a*.txt*"请高手帮忙解决这个问题！！！另外我自己在网上查了下，发现可能是windows xp的问题如果这个问题没法解决的话，那希望哪位高手能帮我想一种另外的方法来查找文件，需求是目标文件夹和文件名由人来输入，文件名可包含通配符，例：a*.java;a*.txt（查找文件名第一个字母为a的java和txt这2种文件）——解决方案——————————————————–VB code
Dim fs As FileSearch Set fs = Application.FileSearch With fs .LookIn = folder .Filename = fileName '(*.txt or *.java) .SearchSubFolders = True If .Execute(msoSortByFileName, msoSortOrderAscending) > 0 Then For i = 1 To .FoundFiles.Count if left(.FoundFiles(i),1)="a" '增加判断第一个字符是否是 "a" Cells(i, 1) = .FoundFiles(i) end if Next End If End With------解决方案--------------------------------------------------------VB code
Option ExplicitPrivate Sub Command1_Click() '示例 Dim Arr() As String Arr = FindFile("C:\Windows", "b*.txt") Dim i As Long For i = 1 To UBound(Arr) MsgBox Arr(i) '读出每一个文件名称 NextEnd SubPrivate Function FindFile(ByVal Folder As String, ByVal fFileName As String) As String() Dim FileName() As String Dim mFileName As String Dim Count As Long ReDim FileName(0) As String mFileName = Dir(Folder & "\&; & fFileName) While Len(mFileName) <> 0 Count = Count + 1 ReDim Preserve FileName(Count) As String FileName(Count) = mFileName mFileName = Dir Wend FindFile = FileNameEnd Function------解决方案--------------------------------------------------------VB code
Option ExplicitPrivate Const LB_ADDSTRING = &H180Private Const WM_SETREDRAW = &HBPrivate Const WM_VSCROLL = &H115Private Const SB_BOTTOM = 7Private Const INVALID_HANDLE_VALUE = -1Private Const vbKeyDot = 46Private Type FILETIME dwLowDateTime As Long dwHighDateTime As LongEnd TypePrivate 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 * 260 cAlternate As String * 14End TypePrivate Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As LongPrivate Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPrivate Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As LongPrivate Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As LongPrivate Const DRIVE_CDROM = 5Private Const DRIVE_FIXED = 3Private Const DRIVE_RAMDISK = 6Private Const DRIVE_REMOTE = 4Private Const DRIVE_REMOVABLE = 2Dim FindNumber As IntegerDim Programme1, Programme2, MyPath As StringDim RunTime As IntegerDim files1$, files2%Dim TotalDirs%, TotalFiles%, Running%Dim www As WIN32_FIND_DATA, fitem&, ffile&Dim driveName As StringPublic cSearchResult As StringPrivate Sub SearchDirs(curpath$) Dim dirs%, dirbuf$(), i% 'Label1.Caption = "" 'Label1.Caption = "正在查找：" & curpath$ DoEvents If Not Running% Then Exit Sub End If fitem& = FindFirstFile(curpath$ & "*.*", www) If fitem& <> INVALID_HANDLE_VALUE Then Do If (www.dwFileAttributes And vbDirectory) Then If Asc(www.cFileName) <> vbKeyDot Then TotalDirs% = TotalDirs% + 1 If (dirs% Mod 10) = 0 Then ReDim Preserve dirbuf$(dirs% + 10) End If dirs% = dirs% + 1 dirbuf$(dirs%) = Left$(www.cFileName, InStr(www.cFileName, vbNullChar) - 1) End If ElseIf Not files2% Then TotalFiles% = TotalFiles% + 1 End If Loop While FindNextFile(fitem&, www) Call FindClose(fitem&) End If If files2% Then SendMessage List1.hwnd, WM_SETREDRAW, 0, 0 Call SearchFileSpec(curpath$) SendMessage List1.hwnd, WM_VSCROLL, SB_BOTTOM, 0 SendMessage List1.hwnd, WM_SETREDRAW, 1, 0 End If For i% = 1 To dirs% Text1.Text = curpath$ & dirbuf$(i%) & "\&; SearchDirs curpath$ & dirbuf$(i%) & "\&; Next i%End SubPrivate Sub SearchFileSpec(curpath$) ffile& = FindFirstFile(curpath$ & files1$, www) If ffile& <> INVALID_HANDLE_VALUE Then Do DoEvents If Not Running% Then Exit Sub SendMessage List1.hwnd, LB_ADDSTRING, 0, ByVal curpath$ & Left$(www.cFileName, InStr(www.cFileName, vbNullChar) - 1) Loop While FindNextFile(ffile&, www) Call FindClose(ffile&) End IfEnd SubPrivate Sub Combo1_Change() files1$ = Combo1.TextEnd SubPrivate Sub Combo1_Click() files1$ = Combo1.TextEnd SubPrivate Sub Command1_Click() Dim drvbbitmask&, maxpwr%, pwr% Dim SearchDR As String Dim Index As Integer Dim information As Long 'If Running% Then ' Command1.Caption = "查找" ' Running% = False ' Exit Sub 'End If On Error Resume Next Command1.Caption = "停止" For Index = 0 To Drive1.ListCount - 1 If Len(files1$) = 0 Then Exit Sub Running% = True files2% = True 'List1.Clear information = GetDriveType(Left(Drive1.List(Index), 2)) 'MsgBox ("DriveName=" & Left(Drive1.List(Index), 2) & " DriveType=" & information) If information = DRIVE_CDROM Then GoTo cjl Call SearchDirs(Left(Drive1.List(Index), 2) & "\&;) Running% = False files2% = False If List1.ListCount <> 0 Then cSearchResult = Trim(List1.List(0)) Exit For End Ifcjl: Next Index If FindNumber <= 1 Then Label1.Visible = True If List1.ListCount <> 0 Then Programme1 = Trim(List1.List(0)) & " /n,/e," Label1.Caption = "资源管理器安装在：" & Trim(List1.List(0)) Else Label1.Caption = "没有找到资源管理器！" End If Call Form_Load 'Exit Sub Else Label4.Visible = True If List1.ListCount <> 0 Then Programme2 = Trim(List1.List(0)) Label4.Caption = "画图程序安装在：" & Trim(List1.List(0)) Else Label4.Caption = "没有找到画图程序！" End If End If 'SetupForm.Show Command2.Enabled = True 'Command1.Caption = "查找" 'Call Command2_ClickEnd SubPrivate Sub Command2_Click() Unload Me EndEnd SubPrivate Sub Drive1_Change() driveName = Drive1.DriveEnd SubPrivate Sub Form_Load() SearchFiles.Height = 1800 SearchFiles.Width = 6375 Shape1.Left = 0 Shape1.Top = 0 Shape1.Height = SearchFiles.Height Shape1.Width = SearchFiles.Width Timer1.Enabled = True Timer1.Interval = 1000 RunTime = 0 'Caption = "正在查找资源管理器和画图程序" 'Label1.Caption = "" Label2.Caption = "正在准备，请稍候···" 'Label3.Caption = "选择要查找的文件类型" 'Command1.Caption = "开始查找" 'Command2.Caption = "退出" MyPath = IIf(Right(App.Path, 1) = "\&;, App.Path, App.Path & "\&;) FindNumber = FindNumber + 1 Command2.Enabled = False If FindNumber <= 1 Then Combo1.AddItem "E*.EXE" Combo1.Text = "E*.EXE" Else Combo1.AddItem "ms*.exe" Combo1.Text = "ms*.exe" End If driveName = "c:" List1.Clear SearchFiles.Show 'SetupForm.Hide Call Command1_Click End SubPrivate Sub Timer1_Timer() 'Dim i As String RunTime = RunTime + 1 'i = IIf(Len(Trim(Str(RunTime))) < 2, Space(1), Space(0)) Label5.Caption = "运行时间：" & Trim(Str(RunTime)) & " 秒"End Sub接受失败，是我们不常听到或看到的一个命题，我们大都接受的是正面的教育，
