Private Sub Workbook_Open()

Call MyMacro

Application.DisplayAlerts = False
    If Application.Workbooks.Count = 1 Then
    Application.Quit
    End If

End Sub

__________________________________________________________________________________________________


Sub MyMacro()
    ThisWorkbook.RefreshAll
    ThisWorkbook.Save
    Call MyMacro1
    
End Sub

___________________________________________________________________________________________________


Sub MyMacro1()
    Sheets(Array("Свод")).Select
    Sheets("Свод").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "Z:\Common\Отчеты к КБ\2022\Для рассылки PDF\Daily report.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Sheets("Свод").Select
    Range("A1").Select
    
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  
    On Error Resume Next
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear
    If objOutlookApp Is Nothing Then
    Set objOutlookApp = CreateObject("Outlook.Application")
End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)
    If Err.Number <> 0 Then
    Set objOutlookApp = Nothing: Set objMail = Nothing
    MsgBox "Не удалось создать новое сообщение"
    Exit Sub
End If
  
sTo = Range("B225").Value
sSubject = "Daily report"
sBody = "Daily report"
sAttachment = "Z:\Common\Отчеты к КБ\2022\Для рассылки PDF\Daily report.pdf"
With objMail
    .To = sTo
    .CC = ""
    .BCC = ""
    .Subject = sSubject
    .Body = sBody
    .Attachments.Add sAttachment
    .Save
    .Send
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
    
End Sub

Sub MyMacro()
    Application.ScreenUpdating = False
    Set wb = ThisWorkbook
    Workbooks.Open Filename:= _
    "C:\Users\ЯЯЯЯЯЯЯЯЯ\Desktop\Òåñò_äëÿ_îáíîâëåíèÿ_ñ_ïàðîëåì.xlsm", Password:="12345", WriteResPassword:="12345"
    Set wb1 = ActiveWorkbook
    wb.Activate
    ActiveWorkbook.RefreshAll
    wb.Save
    wb1.Close
    Application.ScreenUpdating = True
End Sub

Sub MyMacro()
    ThisWorkbook.RefreshAll
    ThisWorkbook.Save
    ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Z:\Common\Отчеты к КБ\2022\Для рассылки PDF\Ежедневный отчет.pdf", OpenAfterPublish:=False
    Call MyMacro1
    Call NextRun
End Sub

Sub MyMacro1()
 Sheets(Array("Свод")).Select
    Sheets("Свод").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "Z:\Common\Отчеты к КБ\2022\Для рассылки PDF\Ежедневный отчет.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Sheets("Свод").Select
    Range("A1").Select
    
    Dim objOutlookApp As Object, objMail As Object
    Dim sTo As String, sSubject As String, sBody As String, sAttachment As String
  
    On Error Resume Next
    Set objOutlookApp = GetObject(, "Outlook.Application")
    Err.Clear
    If objOutlookApp Is Nothing Then
    Set objOutlookApp = CreateObject("Outlook.Application")
End If
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)
    If Err.Number <> 0 Then
    Set objOutlookApp = Nothing: Set objMail = Nothing
    MsgBox "Не удалось создать новое сообщение"
    Exit Sub
End If
  
sTo = Range("L49").Value
sSubject = "Ежедневный отчет PDF"
sBody = "Ежедневный отчет PDF"
sAttachment = "Z:\Common\Отчеты к КБ\2022\Для рассылки PDF\Ежедневный отчет.pdf"
With objMail
    .To = sTo
    .CC = ""
    .BCC = ""
    .Subject = sSubject
    .Body = sBody
    .Attachments.Add sAttachment
    .Save
    .Send
End With
Set objOutlookApp = Nothing: Set objMail = Nothing
    
    Call NextRun
End Sub

Sub NextRun()
    TimeToRun = TimeValue("12:04:00")
    Application.OnTime TimeToRun, "MyMacro"
End Sub

Sub Start()
    Call NextRun
End Sub

Sub Finish()
    Application.OnTime TimeToRun, "MyMacro", , False
End Sub

Sub MyMacro()
    ThisWorkbook.RefreshAll
    ThisWorkbook.Save
    Call NextRun
End Sub

Sub NextRun()
    TimeToRun = TimeValue("21:40:00")
    Application.OnTime TimeToRun, "MyMacro"
End Sub

Sub MyMacro1()
    Sheets(Array("Свод")).Select
    Sheets("Свод").Activate
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "Z:\Common\Отчеты к КБ\2022\Для рассылки PDF\Ежедневный отчет.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
    Sheets("Свод").Select
    Range("A1").Select
End Sub

Sub Start()
    Call NextRun
End Sub

Sub Finish()
    Application.OnTime TimeToRun, "MyMacro", , False
End Sub