错误91 - 发送自动电子邮件

时间:2016-02-03 14:58:59

标签: vba excel-vba error-handling excel

我查看了许多不同的标签但找不到我的挑战的解决方案。我正在尝试设置一个代码,以便在达到某个日期后立即发送自动电子邮件。我写的代码总是得到Error91反馈。在遗漏标记的行之后不再发生错误,但是,也没有做任何事情。因此,我想知道您是否可以帮我找到代码中的错误。

    Option Explicit

Private Sub Worksheet_Calculate()
Dim FormulaRange As Range
Dim FormulaCell As Range
Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String
Dim Deadline As Double

NotSentMsg = "Not Sent"
SentMsg = "Sent"

Deadline = Date

Set FormulaRange = Me.Range("R2:R64")

'On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
        If .Value < Deadline Then
                MyMsg = NotSentMsg
                If .Offset(0, 2).Value = NotSentMsg Then
                    Call Mail_with_outlook1
                End If
            Else
                MyMsg = NotSentMsg
            End If
        Application.EnableEvents = False
        .Offset(0, 2).Value = MyMsg
        Application.EnableEvents = True
    End With
Next FormulaCell

ExitMacro:
Exit Sub

'EndMacro:
 '  Application.EnableEvents = True

 '  MsgBox "Some Error occurred." _
 '       & vbLf & Err.Number _
 '      & vbLf & Err.Description

End Sub

遵循Mail_with_outlook1()

的代码
Option Explicit

Sub Mail_with_outlook1()

Dim OutApp As Object
Dim OutMail As Object
Dim strto As String, strcc As String, strbcc As String
Dim strsub As String, strbody As String
Dim FormulaCell As Range

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strto = Cells(FormulaCell.Row, "S").Value  <----- this line gets marked
strcc = ""
strbcc = ""
strsub = "Your subject"
strbody = "Hi " & Cells(FormulaCell.Row, "A").Value & vbNewLine & vbNewLine & _
          "Your total of this week is : " & Cells(FormulaCell.Row, "B").Value & _
          vbNewLine & vbNewLine & "Good job"

With OutMail
    .To = strto
    .CC = strcc
    .BCC = strbcc
    .Subject = strsub
    .Body = strbody
    'You can add a file to the mail like this
    '.Attachments.Add ("C:\test.txt")
    .Display    ' or use .Send
End With

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

非常感谢您提前! 此致,Marius

0 个答案:

没有答案