VBA循环通过文件路径并运行代码 [英] VBA Loop Through a File Path and Run a Code

问题描述

我有以下代码想要运行到文件夹中所有可用的excel文件.理想情况下，我想将文件夹的路径输入到Sheet1的C3单元格中，并输入宏以将代码应用于所有现有文件.

I have the code below that I would like to run to all of the available excel files in a folder. Ideally, I would like to input the path of the folder into cell C3 in Sheet1 and the macro to apply the code to all of the existing files.

该代码会将每个文件的第二张纸简单地保存为PDF版本，完全可以独立运行.

The code will simply save the second sheet of each file into a PDF version, it works perfectly standalone.

示例文件夹路径:C:\ Users \ MMMM \ Desktop \ Project X \ Project II

Sample Folder Path: C:\Users\MMMM\Desktop\Project X\ Project II

有关如何处理此问题的建议?

Suggestions on how to approach this?

Private Sub CommandButton1_Click()



    Dim MyFolder As String, MyFile As String



    With Application.FileDialog(msoFileDialogFolderPicker)

       .AllowMultiSelect = False

       .Show

       MyFolder = .SelectedItems(1)

       Err.Clear

    End With


    Application.ScreenUpdating = False

    Application.DisplayStatusBar = False

    Application.EnableEvents = False

    Application.Calculation = xlCalculationManual





    MyFile = Dir(MyFolder & "\", vbReadOnly)



    Do While MyFile <> ""

        DoEvents

        On Error GoTo 0

        Workbooks.Open Filename:=MyFolder & "\" & MyFile, UpdateLinks:=False


Dim ReportSheet As Worksheet

Dim allColumns As Range



    Set allColumns = Sheets("RT").Columns("N:S")

    allColumns.Hidden = True



    With Worksheets("RT").PageSetup

     .Zoom = False

     .FitToPagesWide = 1

    End With


Filename = ActiveWorkbook.Name



Cell = Replace(Filename, ".xlsx", ".PDF")

Set ReportSheet = Sheets("RT")


Sheets("RT").Select



Sheets("RT").PageSetup.Orientation = xlLandscape



ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _

    ThisWorkbook.Path & "\" & Cell, _

    Quality:=xlQualityStandard, IncludeDocProperties:=True, _

    IgnorePrintAreas:=True, OpenAfterPublish:=True

0

        Workbooks(MyFile).Close SaveChanges:=False

        MyFile = Dir

    Loop


    'turns settings back on that you turned off before looping folders

    Application.ScreenUpdating = True

    Application.DisplayStatusBar = True

    Application.EnableEvents = True

    Application.Calculation = xlCalculationManual


End Sub

推荐答案

这需要参考(请参阅未经测试(所以请告诉我是否有问题)

It's untested (so let me know if anything comes up)

基本上:

1. 如SmileyFtW所建议，它会要求您提供根文件夹
2. 扫描子文件夹中的excel文件(调整代码中的扩展名)
3. 在导出文件的过程中执行DoSomething程序

编辑:添加了处理用户取消文件选择对话框

Added handle user cancel file select dialog

代码:

Option Explicit

' Add a reference to Microsoft Scripting Runtime
' See https://vbaf1.com/filesystemobject/create-microsoft-scripting-runtime-library-reference/

Private Sub ProcessAllFilesInFolder()

    Dim FileSystem As Scripting.FileSystemObject
    Dim fileDialogResult As Office.FileDialog

    Dim folderPath As String

    Set FileSystem = New Scripting.FileSystemObject

    Set fileDialogResult = Application.FileDialog(msoFileDialogFolderPicker)

    With fileDialogResult
        .AllowMultiSelect = False
        .Title = "Select a folder"
        If .Show = True Then
            folderPath = .SelectedItems(1)
        End If
        If .SelectedItems.Count = 0 Then Exit Sub
    End With

    ProcessFolder FileSystem.GetFolder(folderPath)

End Sub

Private Sub ProcessFolder(ByVal targetFolder As Scripting.Folder)
    Dim FileSystem As Scripting.FileSystemObject
    Dim File As Scripting.File
    Dim SubFolder As Scripting.Folder

    Set FileSystem = New Scripting.FileSystemObject

    For Each SubFolder In targetFolder.SubFolders
        ProcessFolder SubFolder
    Next

    For Each File In targetFolder.Files
        If FileSystem.GetExtensionName(File.Name) Like "xls?" And File.Name <> ThisWorkbook.Name Then
            DoSomething File.Path
        End If
    Next
End Sub

Private Sub DoSomething(ByVal filePath As String)

    Dim FileSystem As Scripting.FileSystemObject
    Dim ReportSheet As Worksheet

    Dim targetFileName As String

    targetFileName = Replace(ThisWorkbook.Name, ".xlsm", ".PDF")
    Set ReportSheet = ThisWorkbook.Worksheets("Sheet2")

    ReportSheet.PageSetup.Orientation = xlLandscape
    ReportSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
                    ThisWorkbook.Path & "\" & targetFileName, _
                    Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                    IgnorePrintAreas:=True, OpenAfterPublish:=True
End Sub

让我知道它是否有效！

这篇关于VBA循环通过文件路径并运行代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！