Трудности отправки рабочего листа по электронной почте с помощью кнопки SendWorksheet
У меня есть рабочий лист Excel 2016 с кнопкой «Отправить рабочий лист», предназначенной для отправки по электронной почте рабочего листа всем назначенным получателям. Когда я запускаю следующий код (большая часть которого была получена из другой программы и изменена), я получаю следующие ошибки:
Ошибка выполнения 429: компонент ActiveX не может создать объект.
в Set OutlookApp = CreateObject("Outlook.Application")
так же как
Ошибка выполнения 91: Объектная переменная или С заблокированной переменной блока.
в блоке With
в .To = "email address"
.
Option Explicit Private Sub cmdSendWorksheet_Click() Dim xFile As String Dim xFormat As Long Dim Wb As Workbook Dim Wb2 As Workbook Dim FilePath As String Dim FileName As String Dim OutlookApp As Object Dim OutlookMail As Object 'On Error Resume Next Application.ScreenUpdating = False Set Wb = Application.ActiveWorkbook ActiveSheet.Copy Set Wb2 = Application.ActiveWorkbook Select Case Wb.FileFormat Case xlOpenXMLWorkbook: xFile = ".xlsx" xFormat = xlOpenXMLWorkbook Case xlOpenXMLWorkbookMacroEnabled: If Wb2.HasVBProject Then xFile = ".xlsm" xFormat = xlOpenXMLWorkbookMacroEnabled Else xFile = ".xlsm" xFormat = xlOpenXMLWorkbook End If End Select FilePath = Environ$("temp") & "\" FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss") Set OutlookApp = CreateObject("Outlook.Application") Set OutlookMail = OutlookApp.CreateItem(0) Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat With OutlookMail .To = "email address" .CC = "" .BCC = "" .Subject = "Worksheet Attached" .Body = "Please see attached worksheet" .cmdSendWorksheet.Enabled = True .Attachments.Add Wb2.FullName .Send End With Wb2.Close Kill FilePath & FileName & xFile Set OutlookMail = Nothing Set OutlookApp = Nothing Application.ScreenUpdating = True End Sub
этот код должен выполнять требуемую работу. Но вам нужно обратиться в «Инструменты / Ссылки» и проверить следующую ссылку: Microsoft Scripting Runtime Microsoft Outlook 14.0 Библиотека объектов
Private Sub cmdSendWorksheet_Click() Dim Wb As Workbook Dim FilePath As String Dim FileName As String Dim FileExtensionName As String Dim FileFullPath As String Dim OutlookApp As New Outlook.Application Dim OutlookMail As Outlook.MailItem Dim fso As New FileSystemObject 'On Error Resume Next Application.ScreenUpdating = False Set Wb = ThisWorkbook FilePath = Environ$("temp") & "\" FileName = fso.GetBaseName(Wb.Path & "\" & Wb.Name) & Format(Now, "dd-mmm-yy h-mm-ss") FileExtensionName = fso.GetExtensionName(Wb.Path & "\" & Wb.Name) FileFullPath = FilePath & FileName & "." & FileExtensionName fso.CopyFile Wb.Path & "\" & Wb.Name, FileFullPath 'Sending the email Set OutlookMail = OutlookApp.CreateItem(olMailItem) With OutlookMail .To = "email address" .CC = "" .BCC = "" .Subject = "Worksheet Attached" .Body = "Please see attached worksheet" .Attachments.Add FileFullPath .Display '.Send You can chose .Send or .Display, as you wish End With Kill FileFullPath 'Free the memory Set OutlookMail = Nothing Set OutlookApp = Nothing Set fso = Nothing Application.ScreenUpdating = True Application.Quit End Sub