Question

我有一个包含~300-600个文件的文件夹（取决于月份），各种名称。

我想在每个文件中运行一个宏，而不是单独打开它们。这可能吗？

以下是我想要运行的宏。当我逐个打开文件时它确实有效，但是有这么多，我想减少一些时间。

Sub Przeroby()

Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim y As Variant
Dim sht As Worksheet
Dim LA As Integer
Dim Z As Variant

Set wbk1 = ActiveWorkbook
Set wbk2 = Workbooks.Open("U:\ZBROJARNIA\_WSPOLNE\Przeroby-podsumowanie.xlsx")
wbk1.Activate

Set sht = wbk2.Sheets(1)

y = sht.Columns("A").Find("", sht.Cells(sht.Rows.Count, "A"), xlValues, xlWhole, , xlNext).Row
x = Application.Sheets.Count

 LA = 2

Do While LA < x

Z = wbk1.Sheets(LA).Range("D12").Formula
sht.Cells(y, 1).Formula = Z

Z = wbk1.Sheets(LA).Range("N12").Formula
sht.Cells(y, 2).Formula = Z

Z = wbk1.Sheets(LA).Range("D14").Formula
sht.Cells(y, 3).Formula = Z

Z = wbk1.Sheets(LA).Range("D11").Formula
sht.Cells(y, 4).Formula = Z

Z = wbk1.Sheets(LA).Range("D10").Formula
sht.Cells(y, 6).Formula = Z

Z = wbk1.Sheets(LA).Range("U60").Value
sht.Cells(y, 8).Formula = Z

Z = wbk1.Sheets(LA).Range("U59").Value
sht.Cells(y, 9).Formula = Z

Z = wbk1.Sheets(LA).Range("U58").Value
sht.Cells(y, 10).Formula = Z

Z = wbk1.Sheets(LA).Range("U57").Value
sht.Cells(y, 11).Formula = Z

Z = wbk1.Sheets(LA).Range("U56").Value
sht.Cells(y, 12).Formula = Z

Z = wbk1.Sheets(LA).Range("U55").Value
sht.Cells(y, 13).Formula = Z

Z = wbk1.Sheets(LA).Range("U54").Value
sht.Cells(y, 14).Formula = Z

Z = wbk1.Sheets(LA).Range("U53").Value
sht.Cells(y, 15).Formula = Z

Z = wbk1.Sheets(LA).Range("U54").Value
sht.Cells(y, 16).Formula = Z

Z = wbk1.Sheets(LA).Range("U53").Value
sht.Cells(y, 17).Formula = Z

Z = wbk1.Sheets(LA).Range("U52").Value
sht.Cells(y, 18).Formula = Z

Z = wbk1.Sheets(LA).Range("U51").Value
sht.Cells(y, 19).Formula = Z


LA = LA + 1
y = y + 1
Range("U49:U60").Copy


Loop

wbk2.Save
wbk2.Close


End Sub

我知道这并不完美，但它完成了工作。此外，任何有上述提示将不胜感激。

编辑：目标目录位于另一台计算机上，我通过内部网络连接到该计算机。带有排序数据的文件位于另一个网络驱动器上。

Answer 1

您可以创建可以运行的小.vbs文件（通过双击），它将自动在指定文件夹中的所有文件上运行宏。

首先将您的工作宏导出到某个位置。然后复制粘贴到文本文件中的行下方并将其另存为.vbs文件。

Dim objFSO, objStartFolder, objFolder, colFiles, filePath
Dim xlApp, xlBook

Set objFSO = CreateObject("Scripting.FileSystemObject")
objStartFolder = "Your folder path"

Set objFolder = objFSO.GetFolder(objStartFolder)
Set colFiles = objFolder.Files
For Each objFile in colFiles
    filePath = objStartFolder & "\" & objFile.Name

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False

    Set xlBook = xlApp.Workbooks.Open(filePath)
    xlApp.VBE.ActiveVBProject.VBComponents.Import "Path to your .bas file"
    xlApp.Run "Name of your Sub"
    xlBook.Save
    xlBook.Close
    xlApp.Quit
Next

Set colFiles = Nothing : Set objFolder = Nothing : Set objFSO = Nothing
Set xlBook = Nothing : Set xlApp = Nothing : Set fso = Nothing

只需更改文件中的路径即可。

Answer 2

您也可以创建Excel Addin，而不是创建vbs文件。此插件可以包含您需要为每个工作簿运行的宏。确实需要打开工作簿来执行宏，但是可以打开（稍后关闭）它们，而不会看到它们。我还建议您在完成后将您创建的任何工作簿对象设置为空。（设置wbk = Nothing）

Answer 3

您可以使用VBA中的Dir（）函数获取特定目录中所有文件的列表。然后，只需循环遍历每个文件即可打开，运行宏，保存，然后关闭。

以下是一些代码：

sPath = "U:\ZBROJARNIA\_WSPOLNE\"
sFile = Dir(sPath)
Do While sFile <> ""
  sFilePath = sPath + sFile
  Set wkBk = Workbook.Open(sFilePath)

  sName = sFile + "!Przeroby"
  Application.Run sName

  wkBk.Save
  wkBk.Close
  sFile = Dir()
Loop

通过多个文件运行宏

3 个答案: