Ошибка vba 1004 при сохранении файла

The actual error I’m getting is

«Run-time error ‘1004’:

Document not saved.»

and then when I hit debug it takes me to the line

ActiveWorkbook.Save

I’ve got a giant VBA macro that I’m having some problems with. The macro is started in a giant workbook with ~75 or so sheets of data. It starts at the first page, reads the name of the Worksheet to determine which model to run on the data, creates a new workbook, does the calculations and creates the graphs, and then saves the workbook before moving on to the next input sheet. All of this works fine, except for saving the new workbook. There are 4 different models I’m running, and 2 of them save correctly. However, for the other 2 I am faced with this error anytime I try and save them.

OutputFolder = "location of output file" 
If Dir(OutputFolder, vbDirectory) = "" Then
MkDir OutputFolder
End If

Workbooks.Open Filename:="location of input file"    '(this is a path to the file)


Workbooks.Open Filename:="location of lookup table" '(another path)
number_of_reports = Workbooks(InputFile).Sheets.Count
Workbooks(InputFile).Activate 


For i = 1 To number_of_reports

ReportID = ActiveSheet.Name 'get 3 part ID
ID_Lookup = Split(ActiveSheet.Name, "-") 'seperate into individual parts


Workbooks("LookupTable").Activate

'use lookup table
Sheets("CompanyLookup").Select
CompanyID = Range("A" & (ID_Lookup(0) + 1))
CompanyName = Range("B" & (ID_Lookup(0) + 1))

Sheets("CategoryLookup").Select
CategoryID = Range("A" & (ID_Lookup(1) + 1))
CategoryName = Range("B" & (ID_Lookup(1) + 1))

Sheets("ModelLookup").Select
ModelID = Range("A" & (ID_Lookup(2) + 1))
ModelName = Range("B" & (ID_Lookup(2) + 1))


Workbooks(InputFile).Activate
y = Range("B1").End(xlToRight).Column
Workbooks(InputFile).Sheets(ReportID).Select

'name of the workbook
SaveID = CategoryName & "_" & ModelName & "_" & FileID

'create company folder if not there already
Output = "location of output" & CompanyName
If Dir(Output, vbDirectory) = "" Then
MkDir Output
End If

'create model folder if not there already
Output = "location of put" & CompanyName & "" & ModelName
If Dir(Output, vbDirectory) = "" Then
MkDir Output
End If

'where to save workbook
Dim SaveLocation As String
SaveLocation = Output & "" & SaveID & ".xlsx"

'save workbook
Dim NewBook As Workbook
'create WB for output
Set NewBook = Workbooks.Add
With NewBook
    .Title = ReportID
    .Subject = ReportID
    .SaveAs Filename:=SaveLocation
End With



'decide which model to run
If ModelID = 1 Then
Call Regression

ElseIf ModelID = 2 Then
Call VolMix

ElseIf ModelID = 3 Then
Call ProdMix

ElseIf ModelID = 4 Then
Call AvgPrice

End If


Workbooks(SaveID).Activate
Range("A1").Select

deletecheck = Workbooks(SaveID).Sheets.Count

'delete extra sheets
If deletecheck > 3 Then

Call DeleteSheet("Sheet1")
Call DeleteSheet("Sheet2")
Call DeleteSheet("Sheet3")

End If

ActiveWorkbook.Save   'THIS IS WHERE I'M GETTING THE ERROR
ActiveWorkbook.Close

Workbooks(InputFile).Sheets(ReportID).Activate

If i <> number_of_reports Then
ActiveSheet.Next.Select
End If
Next i

So models 2 and 4 are the ones giving me problems when they are trying to be saved., the others are not. I’ve looked at the code for each of the models and I can’t find any difference between the 4 that would be causing this, but obviously something is wrong. Any ideas or suggestions?

I have been successfully running a macro which saves my Excel sheet as a PDF and emails my Executive team.

I redesigned it, by creating a new sheet, and updated the code accordingly.

Sub NewDashboardPDF()

' New Executive Daily Dashboard Macro
'
' Create and email the Executive TEAM the Daily Dashboard.
    Dim strPath As String, strFName As String
    Dim OutApp As Object, OutMail As Object

' Create and email the Daily Report to Mitch/Dave/John/Jason ALL PAGES.
    Sheets("Executive Dashboard").Select
    strPath = Environ$("temp") & "" 'Or any other path, but include trailing ""
    strFName = Worksheets("Executive Dashboard").Range("V2").Value & " " & Format(Date, "yyyymmdd") & ".pdf"

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        strPath & strFName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

     'Set up outlook
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
     'Create message
    On Error Resume Next
    With OutMail
        .to = xxx@testemail.com
        .CC = "steve@testemail.com"
        .BCC = ""
        .Subject = "Daily Dashboard"
        .Body = "All, " & vbNewLine & vbNewLine & _
                        "Please see the attached daily dashboard." & vbNewLine & _
                        "If you have any questions or concerns, please do not hesitate to contact me." & vbNewLine & _
                        "Steve"
        .Attachments.Add strPath & strFName
        .Display
        .Send
    End With
     'Delete any temp files created
    Kill strPath & strFName
    On Error GoTo 0

End Sub

The error message I get is Run-Time Error ‘1004’ Document not saved. The document may be open or an error may have been encountered.

When I debug, the following section is highlighted with the arrow on the last line.

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

All references to the old sheet were updated to the new one so I do not believe that is the issue.

On another note, I would love to know how to create this email with my default email signature included. Currently it is just formatted as a plain text email.

Добрый день.
Проблема такая: есть файл, расширение файла xlsm.
В нем делаются вычисления, затем запускается макрос, который копирует активный лист в новый файл, сохраняет его в файл с названием export и текущей датой.
Но, если я хочу сделать файл с макросом как шаблон с расширением xltm, то при запуске макроса получаю сообщение run -time error 1004.
В чем может быть ошибка?

Sub save_data()
    Dim dtDate As Date 
    dtDate = Date
    
    Dim s As Worksheet 
    Dim wb As Workbook  
    Set wb = ActiveWorkbook
    For Each s In wb.Worksheets
        s.Copy
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & "export_" & Format(dtDate, "dd-mm-yyyy") & ".xlsx", FileFormat:=51
    Next
    ActiveSheet.Shapes("Button 1").Select 
   Selection.Delete
         End Sub