现已拥有2003版代码，但由于即03版excel之后，微软取消了vba的filesearch功能，不知为何，请问有高手可以用别的代码代替此功能吗？ 可以在excel2010中使用的代码 有人会用filesystemobject ，或者其他代码能达到效果就可以~ 谢谢~
Sub printer1()
Dim fd As FileDialog, oFile As Object
Dim Fso, myFolder As Object, myFiles As Object
Dim fn$ '定义一些要用到的变量,分别获取文件夹名,文件名
Set Fso = CreateObject("Scripting.FileSystemObject") '创建文件操作
Set fd = Application.FileDialog(msoFileDialogFolderPicker) '用对话框获取文件夹路径
If fd.Show <> -1 Then Exit Sub '如果在文件夹选择时点"取消"则退出过程
Set myFolder = Fso.GetFolder(fd.InitialFileName) '将文件夹路径赋值到变量
With Application.FileSearch
.LookIn = myFolder '设置文件的搜索路径
.FileType = msoFileTypeExcelWorkbooks '设置要搜索的文件类型为工作簿
If .Execute > 0 Then '如果找到一个或多个文件
For i = 1 To .FoundFiles.Count '设置打开工作簙的循环
Workbooks.Open Filename:=.FoundFiles(i) '打开找到的每一个工作簙
ol = 1
Sheets("评级审批表").PrintOut Copies:=ol '打印指定工作表
ActiveWorkbook.Save '保存当前工作簙
ActiveWorkbook.Close '关闭当前工作簙
Next i '打开下一个工作簙
Else
MsgBox "没有找到任何工作簿文件" '提示没有找到任何工作簿文件
End If
End With
End Sub
另
翻墙给你带回来的好东西。
Option Explicit
Function FindFiles(ByVal sPath As String, _
ByRef sFoundFiles() As String, _
ByRef iFilesFound As Integer, _
Optional ByVal sFileSpec As String = "*.*", _
Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean
'
' FindFiles
' ---------
' Find all files matching the specified file spec, starting from the specified path
' and search subfolder as required.
'
' Parameters
' ----------
' sPath (String): Startup folder, e.g. "C:\Users\Username\Documents"
'
' sFoundFiles (String): Two dimensional array to store the path and name of found files.
' The dimension of this array is (1 To 2, 1 To nnn), where nnn is the number of found
' files. The elements of the array are:
' sFoundFiles(1, xxx) = File path (xxx = 1 to nnn)
' sFoundFiles(2, xxx) = File name
'
' iFilesFound (Integer): Number of files found.
'
' sFileSpec (String): Optional parameter with default value = "*.*"
'
' blIncludeSubFolders (Boolean): Optional parameter with default value = False
' (which means sub-folders will not be searched)
'
' Return values
' -------------
' True: One or more files found, therefore
' sFoundFiles = Array of paths and names of all found files
' iFilesFound = Number of found files
' False: No files found, therefore
' iFilesFound = 0
'
' ********************************** Important Note **********************************
'
' When searching for *.xls, FindFiles returns, in addition to xls files, xls* (not xls?)
' files (e.g. xlsX, xlsM, xlsWhatever, etc.). The reason is that FindFiles uses the Dir
' function and these files are returned by Dir! The most interesting thing here is that
' Windows search (including DOS DIR command) returns the same! It seems Excel Dir uses
' Windows search without any further checking or refinements.
'
' This is also true for *.doc and *.ppt files. Actually, this is true whenever a
' three-character file extension is specified; *.txt, *.pdf, *.x?s, etc.
'
' Moreover, if the last character of the specified extension was a question mark (?) or
' an asterisk (*), the returned files would be the same (e.g. *.txt? and *.txt* return
' the same files). This means, files with more than four-character extension are returned
' in both cases. This is exactly the same behaviour when specifying three-character
' extension (*.txt)…so weird!
'
' The aforementioned behaviour was observed in Windows 7 using Excel 2010 (mostly, Excel
' is not a key player here).
'
' Not everything is covered in this note as further tests might reveal more. So, keep
' these things in mind when using Dir or FindFile.
'
' Constructive comments and Reporting of bugs would be appreciated.
'
' **************************************************************************************
'
' Using the function (sample code)
' --------------------------------
' Dim iFilesNum As Integer
' Dim iCount As Integer
' Dim sMyFiles() As String
' Dim blFilesFound As Boolean
'
' blFilesFound = FindFiles("C:\Users\Username\Documents", _
' sMyFiles, iFilesNum, "*.xls", True)
' If blFilesFound Then
' For iCount = 1 To iFilesNum
' MsgBox "Path: " & sMyFiles(1, iCount) & vbNewLine & _
' vbNewLine & "File name: " & sMyFiles(2, iCount), _
' vbInformation, "Files Found"
' Next
' End If
'
Dim iCount As Integer '* Multipurpose counter
Dim sFileName As String '* Found file name
'*
'* FileSystem objects
Dim oFileSystem As Object, _
oParentFolder As Object, _
oFolder As Object
Set oFileSystem = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set oParentFolder = oFileSystem.GetFolder(sPath)
If oParentFolder Is Nothing Then
FindFiles = False
On Error GoTo 0
Set oParentFolder = Nothing
Set oFileSystem = Nothing
Exit Function
End If
sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
'*
'* Find files
sFileName = Dir(sPath & sFileSpec, vbNormal)
Do While sFileName <> ""
iCount = UBound(sFoundFiles, 2)
iCount = iCount + 1
ReDim Preserve sFoundFiles(1 To 2, 1 To iCount)
sFoundFiles(1, iCount) = sPath
sFoundFiles(2, iCount) = sFileName
sFileName = Dir()
Loop
If blIncludeSubFolders Then
'*
'* Select next subforbers
For Each oFolder In oParentFolder.SubFolders
FindFiles oFolder.Path, sFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
Next
End If
FindFiles = UBound(sFoundFiles, 2) > 0
iFilesFound = UBound(sFoundFiles, 2)
On Error GoTo 0
'*
'* Clean-up
Set oFolder = Nothing
Set oParentFolder = Nothing
Set oFileSystem = Nothing
End Function
' Using the function (sample code)
' --------------------------------
' Dim iFilesNum As Integer
' Dim iCount As Integer
' Dim sMyFiles() As String
' Dim blFilesFound As Boolean
'
' blFilesFound = FindFiles("C:\Users\Username\Documents", _
' sMyFiles, iFilesNum, "*.xls", True)
' If blFilesFound Then
' For iCount = 1 To iFilesNum
' MsgBox "Path: " & sMyFiles(1, iCount) & vbNewLine & _
' vbNewLine & "File name: " & sMyFiles(2, iCount), _
' vbInformation, "Files Found"
' Next
' End If
'
这是用法哦。但愿你英文不会太差。看不懂，我可以提供字面上的解释（代码不一定能解释）