为什么这个VB脚本不发送电子邮件?
问题描述:
我在Excel中有以下脚本,它应该发送一封电子邮件(收件人应该在B24中),但我没有收到任何错误消息,但电子邮件也没有发送。任何帮助将非常感激。为什么这个VB脚本不发送电子邮件?
有人可以向我解释什么是错的,或者我在这里做错了什么?
Sub Email2()
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
TempFilePath = Environ$("temp") & "\"
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsm": FileFormatNum = 52
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set OutApp = CreateObject("Outlook.Application")
For Each sh In ThisWorkbook.Worksheets
If sh.Range("B28").Value Like "?*@?*.?*" Then
sh.Copy
Set wb = ActiveWorkbook
TempFileName = "Performance " & sh.Name & " date " & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutMail = OutApp.CreateItem(0)
With wb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.TO = sh.Range("B24").Value
.CC = ""
.BCC = ""
.Subject = "This is the subject"
.Body = "Hello,"
.Attachments.Add wb.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Set OutMail = Nothing
Kill TempFilePath & TempFileName & FileExtStr
End If
Next sh
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
答
你为我提供工作在Excel 2010中
所有我能看到的是,你是否在“B28”的值看起来像一个电子邮件地址,然后发送电子邮件到的代码地址在“B24”中。这是问题吗?
对于我的测试,我把我的地址放在“B28”和“B24”中。
+0
大声笑 - 我正准备发表评论! (我想我会+1,因为它几乎肯定会是原因。) – YowE3K
您是否尝试过在没有“On Error Resume Next”的情况下运行它,以便您可以查看是否有任何错误?你是否已经浏览了代码,看看它是否达到'.Send'? – YowE3K
是的,我已经尝试过了,但仍然没有错误信息 – mabanger
尝试将'.Send'改为'.Display'(我认为是对的 - 但我从未使用过Outlook VBA),以便它显示消息而不是发送它。它显示吗? – YowE3K