通过SendWorksheet按钮通过电子邮件发送工作表的困难

时间:2016-09-02 15:49:45

标签: excel vba excel-vba

我有一个带有“发送工作表”按钮的Excel 2016工作表,用于通过电子邮件将工作表发送给所有指定的收件人。当我运行以下代码(大部分来自另一个程序并进行调整)时,我收到以下错误:

  

运行时错误429:ActiveX组件无法创建对象。

Set OutlookApp = CreateObject("Outlook.Application")

以及

  

运行时错误91:对象变量或未设置块变量。

位于With的{​​{1}}块。

.To = "email address"

1 个答案:

答案 0 :(得分:1)

此代码应该完成您需要的工作。但您需要进入工具/参考,并检查以下参考: 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