通过SendWorksheetbutton通过电子邮件发送工作表的困难

我有一个带有“发送工作表”button的Excel 2016工作表，旨在通过电子邮件将工作表发送给所有指定的收件人。 当我运行下面的代码（其中大部分来自另一个程序并进行调整）时，我收到以下错误：

运行时错误429：ActiveX组件不能创build对象。

Set OutlookApp = CreateObject("Outlook.Application")

以及

运行时错误91：对象variables或块variables未设置。

在.To = "email address"的With块中。

 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 

Answer 1

这个代码应该做你需要的工作。 但是，您需要进入工具/参考并检查以下参考：Microsoft脚本运行时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