时间戳

首页 > 解决方案 > 对象'_Workbook'的方法'SaveAs'在其他计算机上失败

excel - 对象'_Workbook'的方法'SaveAs'在其他计算机上失败

问题描述

我有一个代码将一个工作簿拆分为 500 个左右。此代码从一个工作簿运行并打开另一个工作簿进行拆分。在我的电脑上，这每次都可以正常工作。在其他情况下，代码将首先停在 ws.copy 行。他们停止代码并重新开始。然后代码将适用于前 180-220 张然后弹出“另存为”错误。根据在线阅读，我认为这是内存问题或计时错误。为了解决这个问题，我添加了一个 .wait 函数无济于事。任何帮助将不胜感激！下面的代码供参考。

Sub Splitbook()

Dim MyFile As String
MyFile = Sheets("Steps").Range("C6")

Windows(MyFile).Activate

Dim xPath As String

xPath = Application.ActiveWorkbook.Path

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For Each ws In ActiveWorkbook.Sheets

ws.Copy

Name = ws.Range("C15").Value

Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & Name & ".xlsx"

Application.ActiveWorkbook.Close False

newHour = Hour(Now())

newMinute = Minute(Now())

newSecond = Second(Now()) + 1

waitTime = TimeSerial(newHour, newMinute, newSecond)

Application.Wait waitTime

Next

Application.DisplayAlerts = True

Application.ScreenUpdating = True

ActiveWorkbook.Close SaveChanges:=False

MsgBox ("Split Complete. Press Ok to finish."), vbOKOnly, ("Thank you for your Patience.")

End Sub

编辑

根据您的反馈，我将代码更新如下：

Sub Splitbook()

Dim MyFile As String

Dim wb As Workbook

MyFile = Sheets("Steps").Range("C6")

Set wb = Application.Workbooks(MyFile)

Windows(MyFile).Activate

Dim Loc As String

Loc = Application.ActiveWorkbook.Path

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For Each ws In wb.Sheets

ws.Copy

Name = ws.Range("C15").Value

Application.ActiveWorkbook.SaveAs Filename:=Loc & "\" & Name & ".xlsx"

DoEvents

Application.ActiveWorkbook.Close False

Next

Application.DisplayAlerts = True

Application.ScreenUpdating = True


wb.Close SaveChanges:=False

MsgBox ("Split Complete. Press Ok to finish."), vbOKOnly, ("Thank you for your Patience.")

End Sub

标签： excelvbamemory

解决方案

ActiveWorkbook因此,Activate和Select的危险ActiveSheet。它们可能不是您所期望的，代码所在的位置很重要。如果您从Module,Sheet或ThisWorkbook也有所作为。如果您要从模块运行，则需要限定位置 - which或Workbook您正在引用。当您通过复制没有目的地的工作表来创建新工作簿时，这将是一段时间的活动工作簿，同时您需要锚定到您的起始文件。SheetRange

Sub Splitbook()

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Dim OrigWb As Workbook
    Set OrigWb = ThisWorkbook 'or Set OrigWb = Workbooks("SplitFile") or some filename if not ThisWorkbook

    Dim xPath As String
    xPath = OrigWb.Path

    For Each ws In OrigWb.Sheets
        NewFileName = ws.Range("C15").Value
        ws.Copy
        With ActiveWorkbook
            .SaveAs Filename:=xPath & "\" & NewFileName & ".xlsx"
            .Close False
        End With
        MsgBox ("Split Complete. Press Ok to finish."), vbOKOnly, ("Thank you for your Patience.")
    Next ws

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

这有效，除非Range("C15")为空白或无效，否则将有效。该文件不会保存，您不会知道，因为您关闭了警报。您可能需要先检查范围是否为空。

If Not IsEmpty(ws.Range("C15").Value Then

推荐阅读