Excel VBA - электронная почта не отправляется при блокировке компьютера

У меня возникают проблемы с отправкой сообщений Outlook Outlook с помощью Excel VBA. У меня есть код для этого - Sendupdate - и он отлично работает, когда я вручную запускаю макрос. Мой второй макрос StartTimer предназначен для выполнения вышеуказанного в установленное время, когда я не нахожусь за своим столом.

Однако, когда компьютер заблокирован, электронное письмо не отправляется. Когда я вернусь к своему столу, электронная почта там висит там как черновик, и мне нужно нажать кнопку send.

Вот мой код:

Sub SendUpdate()
Recipient = "[email protected]"
Subj = "update"
Dim msg As String
msg = "hello"

HLink = "mailto:" & Recipient & "?"
HLink = HLink & "subject=" & Subj & "&"
HLink = HLink & "body=" & msg
ActiveWorkbook.FollowHyperlink (HLink)
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.SendKeys "%s"
End Sub

Sub StartTimer()
Application.OnTime TimeValue("18:00:00"), "SendUpdate"

End Sub

Есть ли способ закодировать макрос, чтобы убедиться, что письмо нажата?

Ответ 1

Я сломаю это "Учебное пособие" за 3 шага.

1) Написание макроса Excel

2) Подготовка файла vbscript

3) Настройка задачи в Планировщике задач Windows

ПИСЬМО МАСЛА EXCEL

Откройте новый файл в Excel и в модуле, вставьте этот код

Option Explicit

Const strTo As String = "[email protected]"
Const strCC As String = "[email protected]"  '<~~ change "[email protected]" to "" if you do not want to CC
Const strBCC As String = "[email protected]" '<~~ change "[email protected]" to "" if you do not want to BCC

Sub Sample()
    Dim OutApp As Object, OutMail As Object
    Dim strbody As String, strSubject As String

    strSubject = "Hello World"
    strbody = "This is the message for the body"

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = strTo
        .CC = strCC
        .BCC = strBCC
        .Subject = "This is the Subject line"
        .Body = strbody
        .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Сохраните файл Excel как C:\Tester.Xlsm, если вы используете Excel 2007 или C:\Tester.Xls, если используете Excel 2003 и выходите из

ПОДГОТОВКА ФАЙЛА VBSCRIPT

Откройте "Блокнот" и вставьте этот код. Измените расширение ".xls", если применимо.

Dim xlApp
Dim xlBook

Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open("C:\Tester.xls", 0, True)
xlApp.Run "Sample"
xlBook.Close
xlApp.Quit

Set xlBook = Nothing
Set xlApp = Nothing

Сохраните файл как Tester.vbs и закройте его

НАСТРОЙКА ЗАДАЧИ В ЗАПИСИ ЗАДЕРЖКИ WINDOWS

Не могли бы вы подтвердить свою операционную систему Windows? - Siddharth Rout 36 мин назад

Windows XP. Его рабочий компьютер (так же, как и обычные логины и т.д.). - keynesiancross 18 мин назад

Нажмите кнопку "Пуск" | Все программы | Аксессуары | Системные инструменты | Задачи расписания для получения этого окна

Дважды нажмите "Добавить запланированную задачу", чтобы получить это окно

Нажмите "Далее"

Нажмите "Обзор" и выберите файл vbs, который мы создали ранее, и нажмите "открыть"

Следующее окно, которое вы получаете, имеет решающее значение, поскольку здесь мы должны упомянуть, когда script должен запускаться

После того, как вы сделали это, нажмите дальше.

В этом окне введите свои данные для входа, чтобы script мог работать даже при заблокированном экране.

Нажмите "Далее", когда закончите, а затем нажмите "Готово" в следующем окне. Теперь планировщик задач выглядит следующим образом:

И вы закончили

Заблокируйте компьютер и перейдите на кофе-брейк;) Когда вы вернетесь (в зависимости от времени, которое вы установили в планировщике задач и сколько времени ваш перерыв), письмо было отправлено.

НТН

Ответ 2

Я использовал HTML и JavaScript setInterval для запуска кода vba для решения этой проблемы. Код:

<html>
<script>

var flag = false;
var xlApp;
var xlBook;
var i = 0;

function processExcel()
{
//Open the excel containing macro for the first time
if(flag==false)
{
  xlApp = new ActiveXObject ( "Excel.Application" );
//Your Excel containing VBA code
  xlBook=xlApp.Workbooks.Open("Count1.2.xlsm")

}
// "a" is the VBA macro
 xlApp.Run("a");

flag=true;


 i++;
 window.status="Last Updated " + new Date();


}

var w
function run()
{

processExcel();

 w= setInterval("processExcel()",120000);


}
function stop()
{

 clearInterval(w);


}

</script>

<body >

<input type="button" value="Start" onclick="run()" />
<input type="button" value="Stop"  onclick="stop()"/>


</body>
</html>

Ответ 3

SendKeys, скорее всего, виновник. Я все еще использую CDO для отправки электронной почты через Excel VBA. Это должно начать: http://www.rondebruin.nl/cdo.htm