Трудности с выполнением скрипта VBA каждый час

Я пытаюсь использовать этот сценарий VBA (который отправляет мне электронное письмо, если задача достигает своей даты выполнения) каждый час или около того. Я просмотрел учебники и попробовал несколько примеров, но каждый раз, когда я пытаюсь запустить его, я получаю сообщение. Кто-нибудь будет достаточно любезен, чтобы дать ему быстрый взгляд?

Спасибо!

Option Explicit

Private Sub TaskTracker()
Dim FormulaCell          As Range
Dim FormulaRange    As Range
Dim NotSentMsg      As String
Dim MyMsg           As String
Dim SentMsg         As String
Dim MyLimit         As Double

NotSentMsg = "Not Sent"
SentMsg = "Sent"

'Equals the MyLimit value it will triger the email
MyLimit = Date


Set FormulaRange = Me.Range("E5:E35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If .Value = MyLimit Then
                MyMsg = NotSentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    strTO = "[email protected]"
                    strCC = "[email protected]"
                    strBCC = ""
                    strSub = "Greetings " & Cells(FormulaCell.Row, "B").Value
                    strBody = "Hi Sir, " & vbNewLine & vbNewLine & _
                        "This email is to notify that you need to do your task : " & Cells(FormulaCell.Row, "B").Value & _
                        vbNewLine & vbNewLine & "Regards, Yourself"
                    If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg
'Call Mail_with_outlook2

 End If
            Else
                MyMsg = NotSentMsg
            End If
        Application.EnableEvents = False
        .Offset(0, 1).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
Call AutoRun
End Sub


Sub AutoRun()
Application.OnTime Now + TimeValue("00:00:10"), "TaskTracker"
End Sub

Насколько я понимаю, сценарий должен вызвать подпрограмму автозапуска перед завершением. Но это не так. Когда я пытаюсь вручную запустить сам модуль AutoRun, он сообщает: «Невозможно запустить макрос» *\Task Tracker.clsm'TaskTracker'. Макрос может быть недоступен в этой книге, или все макросы могут быть отключены».


excel vba autorun
person Francis Maltais    schedule 28.01.2016    source источник
comment
Вызовите автозапуск после Next FormulaCell и удалите часть ExitMacro: Exit Sub и повторите попытку.   -  person Kathara    schedule 28.01.2016
comment
Он говорит, что произошла ошибка: 0, когда я делаю это и пытаюсь запустить его. После отклонения я получаю то же сообщение об ошибке О, эй, еще раз, Катара :D Посмотрите, как я пытаюсь прокачать сценарий, хе-хе   -  person Francis Maltais    schedule 28.01.2016
comment
Вызов автозапуска после следующей формулы и сохранение макроса выхода теперь делают попытки запустить автозапуск (чего раньше не было), но я все еще получаю ошибку «Невозможно запустить макрос *\Task Tracker.xlsm'TaskTracker». Подпрограмма называется TraskTracker но книга называется Task Tracker, может ли это быть частью причины, по которой она думает, что ее не существует? Текущий сценарий находится в самом рабочем листе. Следует ли вместо этого поместить его в рабочую тетрадь? Следует ли размещать AutoRun внутри модуля?   -  person Francis Maltais    schedule 28.01.2016
comment
Да, привет еще раз!! Эххм ок, оставь выходной макрос. Проблема, которую я вижу, заключается в том, что вызов AutoRun находится в операторе endMacro, который будет вызываться только в случае ошибки. Ошибка может быть вызвана тем, что первая подпрограмма еще не завершена, когда вы вызываете автозапуск, а в автозапуске вы снова вызываете эту подпрограмму. Так что это может вызвать бесконечный цикл. Если бы вы могли вызвать автозапуск, когда другая подпрограмма закончилась, проблем не должно быть...   -  person Kathara    schedule 28.01.2016
comment
У меня когда-то была похожая проблема, тогда я записал макрос, куда потом вставил свой код. Только тогда он будет распознан как макрос. Прежде чем вы попробуете это, попробуйте удалить Private перед первой подпрограммой, посмотрите, имеет ли это какое-то значение. :)   -  person Kathara    schedule 28.01.2016
comment
Мне кажется или End If не хватает? Я вижу 3 IF только 2 End If   -  person Fred    schedule 28.01.2016
comment
Да, для If sendMail. Забавно, что вы не получили ошибку для этого .......   -  person Kathara    schedule 28.01.2016
comment
Хм, действительно странно, потому что все работает правильно, прежде чем пытаться запустить его автоматически: O Я отправил себе около 20 электронных писем, выполняя тесты: P Я проверю предложение выше и посмотрю, как оно работает :)   -  person Francis Maltais    schedule 28.01.2016
comment
Трюк с записью макроса заставил его работать! :)   -  person Francis Maltais    schedule 28.01.2016
comment
Хотя каждый раз, когда он запускается (каждые 10 секунд для целей тестирования), если отправленное электронное письмо находится в состоянии «Отправлено», оно переключает его на «Не отправлено», таким образом, бесконечно спамя меня одними и теми же задачами. Есть ли что-то в коде, что вызывает это?   -  person Francis Maltais    schedule 28.01.2016
comment
Я думаю, что исправил это, изменив: If .Value = MyLimit Then MyMsg = NotSentMsg To If .Value = MyLimit Then MyMsg = SentMsg Таким образом, мне нужно вручную установить для него значение Not Sent, сценарий не изменит его, если значение = дата.   -  person Francis Maltais    schedule 28.01.2016
comment
@Fred Существует однострочный синтаксис для If... Then... Else.... End If не нужно.   -  person Egan Wolf    schedule 28.01.2016
comment
@EganWolf Правильно, плохо, я только что заметил 3 If's 2 End If's Надо было поискать это!   -  person Fred    schedule 28.01.2016

Ответы (1)


arrow_upward
2
arrow_downward

Все работает правильно. Спасибо всем! (Оставив ответ на я могу пометить эту тему как отвеченную) :)

Приведенный ниже код отлично работает для меня. Как предложила Катара, Call Autorun нужно было разместить после Next Formula Cell. Кроме того, мне пришлось записать пустой макрос и скопировать и вставить весь код, чтобы проверка цикла работала правильно!

Option Explicit

Private Sub TaskTracker()
Dim FormulaCell          As Range
Dim FormulaRange    As Range
Dim NotSentMsg      As String
Dim MyMsg           As String
Dim SentMsg         As String
Dim MyLimit         As Double

NotSentMsg = "Not Sent"
SentMsg = "Sent"

MyLimit = Date

Set FormulaRange = Range("E5:E35")
On Error GoTo EndMacro:
For Each FormulaCell In FormulaRange.Cells
    With FormulaCell
            If .Value = MyLimit Then
                MyMsg = SentMsg
                If .Offset(0, 1).Value = NotSentMsg Then
                    strTO = "[email protected]"
                    strCC = ""
                    strBCC = ""
                    strSub = "[Task Manager] Reminder that you need to: " & Cells(FormulaCell.Row, "A").Value
                    strBody = "Hello Sir, " & vbNewLine & vbNewLine & _
                        "This email is to notify that you that your task : " & Cells(FormulaCell.Row, "A").Value & " with the following note: " & Cells(FormulaCell.Row, "B").Value & " is nearing its Due Date." & vbNewLine & "It would be wise to complete this task before it expires!" & _
                        vbNewLine & vbNewLine & "Truly yours," & vbNewLine & "Task Manager v1.0"
                    If sendMail(strTO, strSub, strBody, strCC) = True Then MyMsg = SentMsg
'                        Call Mail_with_outlook2
                End If
            Else
                MyMsg = NotSentMsg
            End If
        Application.EnableEvents = False
        .Offset(0, 1).Value = MyMsg
        Application.EnableEvents = True

    End With

Next FormulaCell
Call AutoRun

ExitMacro:
Exit Sub

EndMacro:
Application.EnableEvents = True

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

End Sub

Sub AutoRun()
Application.OnTime Now + TimeValue("00:00:20"), "TaskTracker"
End Sub

Спасибо всем за вашу помощь!

person Francis Maltais    schedule 28.01.2016