Excel VBA Saveas函数损坏文件

Question

当我尝试使用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

Answer 1

通过使用工作簿的名称而不是活动工作簿，我可以解决问题。 其余代码相同，因此其余代码没有引起任何问题。

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