Question

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

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库。在某些情况下，需要启用此库才能与文件系统对象进行交互。

可以通过按Tools＆gt;从Visual Basic编辑器访问此库。参考文献＆gt; Microsoft Scripting Runtime。有关详细信息，请参阅以下链接。

Microsoft Scripting Runtime Library

Answer 3

1代码完成后的一种情况是，您选择了一个空文件夹或选择了一个包含excel文件以外的文件夹。

尝试检查正确的文件夹以选择并执行代码。它应该工作正常。

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

3 个答案: