VBA/Excel 宏编程 - 我正在尝试自动发送带有 Excel 附件的电子邮件。当我尝试添加附件时,我收到以下错误:“对象不支持此属性或方法”。
有没有人有任何想法?不是文件名,文件路径问题,文件存在,路径正确。
Dim wbOld As Workbook
Dim wbNew As Workbook
Dim sheet As Variant
Dim tempFilePath As String
Dim tempFullFileName As String
Dim sErr As String
Dim vSheet As Variant
'Handle Excel screen changes and events
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Set Outlook to send emails
'Set olApp = New Outlook.Application
'Set this workbook to active
Set wbOld = ActiveWorkbook
'Copy sheets from the the old active workbook
wbOld.Sheets(SheetsToEmail).Copy
'Create copy destination workbook
Set wbNew = ActiveWorkbook
'Merge styles from the new workbook into the existing workbook.
wbNew.Colors = Workbooks(wbOld.Name).Colors
'Save the new workbook, mail it and finally delete it
tempFilePath = Environ$("temp") & "\"
tempFullFileName = tempFilePath & NewWorkbookName & ".xlsm"
'In case the workbook already exists, kill it.
'Kill tempFullFileName
'Save
With wbNew
.SaveAs tempFullFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
.Close SaveChanges:=False
End With
sch = "http://schemas.microsoft.com/cdo/configuration/"
Set cdoConfig = CreateObject("CDO.Configuration")
cdoConfig.Fields.Item(sch & "sendusing") = 2
cdoConfig.Fields.Item(sch & "smtpserver") = "server.smtp.address"
cdoConfig.Fields.Update
Set cdoMessage = CreateObject("CDO.Message")
Set cdoMessage.Configuration = cdoConfig
cdoMessage.From = "test@email.com"
cdoMessage.To = "receive_Test@email.com"
'cdoMessage.CC = Send_CC
'cdoMessage.BCC = Send_BCC
cdoMessage.Subject = EmailSubject
cdoMessage.Textbody = EmailBody
cdoMessage.AddAttachement "C:\documents and settings\userAccount\Local%20Settings\Temp\GCCS%20Automated%20Dashboard%20-%202010.xlsm"
cdoMessage.Send
Set cdoMessage = Nothing
Set cdoConfig = Nothing
'Delete new
Kill tempFullFileName
'Set focus on old workbook
Set wbOld = ActiveWorkbook
Send_TO = Replace(Send_TO, ";", vbCrLf)
'Enable application events and draw
'With Application
' .ScreenUpdating = True
' .EnableEvents = True
'End With
'Clean up
Set wsNew = Nothing
'Set olApp = Nothing
'Set olMail = Nothing
Exit Sub