EXCEL 2007：宏在一台 PC 上运行但在其他 PC 上不运行

Question

我为我的老板写了一个宏来打开一个特定的文件夹，其中包含大约 100 个具有相同格式的工作簿，并将这些工作簿中的所有数据整理到宏所在的主机 excel 中。现在的问题是，它在我的 PC 上运行得非常好，但是当我在老板的 PC 上安装运行时，它运行s 没有执行代码（没有数据被整理）并显示成功消息一秒结束。任何帮助表示赞赏。这里是宏代码

Sub collate()

Application.ScreenUpdating = False

Dim folderDialog As FileDialog
Dim folderPath As String, filename As String
Dim temp As Variant
Dim folder As Object, file As Object
Dim row As Integer, lastrow As Integer

MsgBox "Please select the folder containing all the input files", vbOKOnly

Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
folderDialog.AllowMultiSelect = False
folderDialog.Show

On Error GoTo ext
folderPath = folderDialog.SelectedItems(1)

Set temp = CreateObject("Scripting.FileSystemObject")
Set folder = temp.GetFolder(folderPath)
row = Sheet1.Cells(Rows.Count, 2).End(xlUp).row
If row > 3 Then Sheet1.Range("B4:I" & row).Clear
row = 4

For Each file In folder.Files

    filename = file.Name
    filename = Left(filename, Len(filename) - 5)

    Application.Workbooks.Open (folderPath & "\" & filename)
    lastrow = Workbooks(filename).Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).row
    Workbooks(filename).Worksheets("Sheet1").Range("B4:I" & lastrow).Copy

    Sheet1.Range("B" & row).PasteSpecial xlPasteValues
    Sheet1.Range("B" & row).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False

    row = Sheet1.Cells(Rows.Count, 2).End(xlUp).row + 1
    Application.Workbooks(filename).Close savechanges:=False

Next

ext:
If folderPath = "" Then
MsgBox "Folder not selected!"
Application.ScreenUpdating = True
Exit Sub
End If

Sheet1.Range("A1").Select
Application.ScreenUpdating = True
MsgBox "Data successfully merged!", vbInformation
End Sub

Answer 1

试试这个版本

Sub LoopThroughFolder()
    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim Rws As Long, Rng As Range
    Set Wb = ThisWorkbook
    'change the address to suite
    MyDir = "C:\Test2\"

    MyFile = Dir(MyDir & "*.xlsx")    'change file extension

    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        With Worksheets("Sheet1")
            MsgBox "your code goes here -" & MyFile
            '            Rws = .Cells(Rows.Count, "B").End(xlUp).Row
            '            Set Rng = Range(.Cells(2, 1), .Cells(Rws, 2))
            '            Rng.Copy Wb.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            ActiveWorkbook.Close True
        End With
        Application.DisplayAlerts = 1
        MyFile = Dir()
    Loop

End Sub

Answer 2

您可能需要在老板的计算机上启用 Microsoft Scripting Runtime 库（如果您尚未启用的话）。在某些情况下，需要启用此库才能与文件系统对象交互。

可以从 Visual Basic 编辑器中按“工具”>“参考”>“Microsoft 脚本运行时”访问此库。有关详细信息，请参阅下面的 link。

Microsoft Scripting Runtime Library

Answer 3

1 种代码在一秒钟内完成的情况是当您 select 编辑了一个空文件夹或 select 编辑了一个包含非 excel 文件的文件夹时。

尝试将正确的文件夹检查到 select 并执行代码。它应该可以正常工作。

EXCEL 2007：宏在一台 PC 上运行但在其他 PC 上不运行

EXCEL 2007: macro runs on one PC but not on other

vba

excel

excel-2007