Excel VBA Saveas 函数损坏文件

Question

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

我已经尝试了 ActiveWorkbook.SaveCopyAs 函数，但结果是一样的。下面的例子。我在底部添加了另外两个函数。

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

和无更新：

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

通过使用工作簿的名称而不是 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

Excel VBA Saveas 函数损坏文件

Excel VBA Saveas function corrupting file

excel

vba

save

save-as