Excel VBA Saveas函数破坏文件

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

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

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