Excel VBA Saveas function corrupting file

Question

When I try to save my file with the ActiveWorkbook.Save function. The file get's corrupted and i cannot use it anymore.

I already tried the ActiveWorkbook.SaveCopyAs function, but the result is the same. Below the example. I have added the 2 other functions used on the bottom.

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

function CheckPublished()

Function CheckPublished() As Boolean

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

and the 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

if we jump to einde, I call the following function :

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

By using a name for the workbook than rather activeworkbook I was able to solve the problem; the rest of the code is the same, so the rest was not causing any issues.

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