Excel VBA Saveas 函数损坏文件

Posted 2023-05-07

【中文标题】Excel VBA Saveas 函数损坏文件

【英文标题】：Excel VBA Saveas function corrupting file

【发布时间】：2017-09-05 08:43:31

【问题描述】：

当我尝试使用 ActiveWorkbook.Save 函数保存文件时。文件已损坏，我不能再使用它了。

我已经尝试过 ActiveWorkbook.SaveCopyAs 函数，但结果是一样的。下面的例子。我已经添加了底部使用的其他 2 个功能。

Sub Publish_WB()
Dim ws As Worksheet

Dim cell As Range
Dim CurrentPath, OriginalFname, NewFname, FName As String

If CheckPublished() Then
    MsgBox ("Published version, feature not available ...")
    Exit Sub
End If

NoUpdate
PublishInProgress = True

'Save the Current Workbook
OriginalFname = ActiveWorkbook.Path & "\" & ThisWorkbook.Name

'Store the current path
CurrentPath = CurDir

'Change the path to the same of the current sheet
SetCurrentDirectory ActiveWorkbook.Path

NewFname = Replace(ThisWorkbook.Name, ".xlsm", "_published.xlsm")

FName = Application.GetSaveAsFilename(FileFilter:="Excel files (*.xlsm),*.xlsm", InitialFileName:=NewFname, Title:="Save Published Version as")
If FName <> "" Then
    ActiveWorkbook.SaveAs FName, 52
    ActiveWorkbook.SaveCopyAs (OriginalFname)
Else
    'user has cancelled
    GoTo einde
End If

函数 CheckPublished()

Function CheckPublished() As Boolean

If Range("Quoting_Tool_Published").Value = True Then
    CheckPublished = True
Else
    CheckPublished = False
End If
End Function

和 NoUpdate ：

Sub NoUpdate()
If NoUpdateNested = 0 Then
    CurrentCalculationMode = Application.Calculation 'store previous mode
End If

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
    'Application.Cursor = xlWait


    NoUpdateNested = NoUpdateNested + 1
   ' Debug.Print "NoUpdate, Noupdatenested = " & NoUpdateNested

End Sub

如果我们跳转到 einde，我会调用以下函数：

Sub UpdateAgain()

NoUpdateNested = NoUpdateNested - 1

If NoUpdateNested < 1 Then
    Application.Calculation = xlCalculationAutomatic 'let all sheets be calculated again first
    Application.Calculation = CurrentCalculationMode 'set to previous mode
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Cursor = xlDefault
Else
    Application.Calculation = xlCalculationAutomatic 'recalculate sheets, but keep the rest from updating
    Application.Calculation = xlCalculationManual
End If

'Debug.Print "UpdateAgain, Noupdatenested = " & NoUpdateNested

End Sub

【问题讨论】：

GoTo einde 是什么，我认为您不会在文件中添加“.xlsm”，因此无需扩展名即可保存

嗨，Tom，Goto Einde 调用了上面的最后一个函数 (UpdateAgain)，函数 thisworkbook.name 得到了包含扩展名的名称

另外，如果在运行之前没有保存工作簿，那么它将尝试保存\Book1，这可以理解地失败

文件是如何损坏的？你能告诉我们错误信息吗？使用SaveCopyAs后保存的文件是否带有扩展名

文件已经保存，开始的名字是QT2.0.16_projectname.xlsm，文件QT2.0.16_projectname_published.xlsm也被创建了，但是我原来的文件已经损坏了

【参考方案1】：

通过使用工作簿的名称而不是 activeworkbook，我能够解决问题；其余代码是相同的，所以其余部分没有引起任何问题。

Sub Publish_WB()
Dim ws As Worksheet
Dim wb as Workbook


Dim cell As Range
Dim CurrentPath, OriginalFname, NewFname, FName As String

If CheckPublished() Then
    MsgBox ("Published version, feature not available ...")
    Exit Sub
End If

NoUpdate
PublishInProgress = True

'Save the Current Workbook
Set wb = ThisWorkbook
wb.Save

'Store the current path
CurrentPath = CurDir

'Change the path to the same of the current sheet
SetCurrentDirectory ActiveWorkbook.Path

NewFname = Replace(ThisWorkbook.Name, ".xlsm", "_published.xlsm")

FName = Application.GetSaveAsFilename(FileFilter:="Excel files (*.xlsm),*.xlsm", InitialFileName:=NewFname, Title:="Save Published Version as")
If FName <> "" Then
    wb.SaveAs FName, 52
Else
    'user has cancelled
    GoTo einde
End If