Excel VBA Saveas Funktion korrumpierende Datei

Question

Wenn ich versuche, meine Datei mit der ActiveWorkbook.Save-Funktion zu speichern. Die Datei wird beschädigt und ich kann sie nicht mehr verwenden.

Ich habe bereits die Funktion ActiveWorkbook.SaveCopyAs versucht, aber das Ergebnis ist das gleiche. Unterhalb des Beispiels. Ich habe die 2 anderen Funktionen auf der Unterseite hinzugefügt.

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 

Funktion CheckPublished()

Function CheckPublished() As Boolean 

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

und die 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 

wenn wir Einde springen, nenne ich die folgende Funktion:

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

Durch die Verwendung von ein Name für das Arbeitsbuch als ra Ich konnte das Problem lösen. Der Rest des Codes ist derselbe, so dass der Rest keine Probleme verursachte.

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