Приведенный ниже код отлично работает только в этом. Отправить вызывает проблемы, я не знаю почему
Sub Email_CurrentWorkBook()
Dim UserInputToEmail As String
'Не забудьте изменить идентификатор электронной почты перед запуском этого кода
Dim OlApp As Object
Dim NewMail As Object
Dim TempFilePath As String
Dim FileExt As String
Dim TempFileName As String
Dim FileFullPath As String
Dim MyWb As Workbook
Set MyWb = ThisWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
TempFilePath = Environ $ ("temp") & "\"
FileExt = "." & LCase(Right(MyWb.Name, Len(MyWb.Name) - InStrRev(MyWb.Name, ".", , 1)))
TempFileName = MyWb.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss")
FileFullPath = TempFilePath & TempFileName & FileExt
MyWb.SaveCopyAs FileFullPath
Set OlApp = CreateObject("Outlook.Application")
Set NewMail = OlApp.CreateItem(0)
UserInputToEmail = Application.InputBox("Please enter an email address: ")
With NewMail
.To = UserInputToEmail
.CC = ""
.BCC = ""
.Subject = "Automated file output"
.Body = "Hello, Please find the attached your automated script output"
.Attachments.Add FileFullPath '
--- полный путь к временному файлу, в котором он сохранен. Dim T1 As Variant Dim T2 As Variant
T1 = Now()
T2 = DateAdd("s", 1, T1)
Do Until T2 <= T1
T1 = Now()
Loop
NewMail.Send
.Send
End With
On Error GoTo 0
Kill FileFullPath
Set NewMail = Nothing
Set OlApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub