weixin_41603318
weixin_41603318
采纳率0%
2018-01-22 10:36

打印文件夹下所有工作簿中指定的工作表

80

现已拥有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

  • 点赞
  • 写回答
  • 关注问题
  • 收藏
  • 复制链接分享
  • 邀请回答

3条回答

  • caozhy 从今以后生命中的每一秒都属于我爱的人 3年前

    ' 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
    '
    这是用法哦。但愿你英文不会太差。看不懂,我可以提供字面上的解释(代码不一定能解释)

    点赞 评论 复制链接分享
  • caozhy 从今以后生命中的每一秒都属于我爱的人 3年前
  • caozhy 从今以后生命中的每一秒都属于我爱的人 3年前

    翻墙给你带回来的好东西。

    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 
    
    点赞 评论 复制链接分享

相关推荐