Question

我在VBA中有代码，它将具有相同选项卡名称的工作表从不同的工作簿复制到一个工作簿中。代码从中拉出的工作簿位于一个文件夹中。代码在Excel 2010中运行正常但是当我在Excel 2013中运行它时，我收到以下1004错误消息：＆＃34;抱歉，我们无法找到.... xlsx。它是否可能被移动，重命名或删除。＆＃34;我不知道从哪里开始排除故障。有没有人遇到这个问题，或者有任何想法为什么它在Excel 2010而不是Excel 2013中可以正常工作？谢谢。

Sub CombineSheets()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim sPath As String
Dim sFname As String
Dim wBk As Workbook
Dim wSht As Variant

Application.EnableEvents = False
Application.ScreenUpdating = False
sPath = "PathName\Inputs"
ChDir sPath
sFname = "*"
sFname = Dir(sPath & "\" & sFname & ".xlsx*", vbNormal) <Code bombs here>
wSht = ("Risks")
Do Until sFname = ""
    Set wBk = Workbooks.Open(sFname)
    Windows(sFname).Activate
    Sheets(wSht).Copy Before:=ThisWorkbook.Sheets(1)
    wBk.Close False
    sFname = Dir()
Loop
ActiveWorkbook.Save
Application.EnableEvents = True
Application.ScreenUpdating = True

Answer 1

您确定此代码以前有效吗？

如果确实如此，那么您的应用程序的默认文件路径可能已更改。您可以使用Debug.Print Application.DefaultFilePath进行检查。无论如何，您最好在sPath变量中明确定义完整路径名。

如果您想要获取旧版Excel文档，那么Dir函数中的字符串可能只是“* .xls *”（但这也会收集启用宏的工作簿）。我想知道这是否最初是在你的代码中使用asterix。

无需激活窗口，但您可能需要一个错误处理行来检查工作簿中是否存在“Risks”表。

您的代码中也存在一些冗余，因此整个过程应该正常工作，如下所示：

Sub CombineSheets()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Worksheet

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    sPath = "PathName\Inputs" 'make this a full path eg "C:\..."
    sFname = Dir(sPath & "\" & "*.xls*", vbNormal)
    Do Until sFname = ""

        'skip if it's this workbook
        If sFname <> ThisWorkbook.Name Then
            Set wBk = Workbooks.Open(sPath & "\" & sFname)

            'check a "Risks" sheet exists
            Set wSht = Nothing
            On Error Resume Next
            Set wSht = wBk.Sheets("Risks")
            On Error GoTo 0

            If Not wSht Is Nothing Then
                wSht.Copy Before:=ThisWorkbook.Sheets(1)
            End If

            wBk.Close False

        End If

        sFname = Dir()
    Loop
    ActiveWorkbook.Save
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

VBA代码在Excel 2010中工作但不在Excel 2013中工作

1 个答案: