Добрый день!
Не получается прикрепить вложение к письму: файл лежит на сетевом диске. На работе стоит терминал и своего диска нет...
Не получается прикрепить вложение к письму: файл лежит на сетевом диске. На работе стоит терминал и своего диска нет...
Код |
---|
Sub Send_Mail() Dim objOutlookApp As Object, objMail As Object Application.ScreenUpdating = False On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт Set objOutlookApp = GetObject(, "Outlook.Application") Err.Clear 'Outlook закрыт, очищаем ошибку If objOutlookApp Is Nothing Then Set objOutlookApp = CreateObject("Outlook.Application") End If objOutlookApp.Session.Logon 'если не получилось создать приложение или экземпляр сообщения - выходим If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub 'цикл от второй строки(начало данных с адресами) до последней ячейки таблицы Text_soobheniya = "Добрый день! " For lr = 2 To 3 'Cells(Rows.Count, 1).End(xlUp).Row ' до конца строк 'создаем сообщение Set objMail = objOutlookApp.CreateItem(0) 'создаем новое сообщение With objMail .To = Cells(lr, 36) 'адрес получателя .CC = Cells(lr, 39) 'адрес для копии .BCC = "" 'адрес для скрытой копии .Subject = "Уведомление" 'тема сообщения .Body = Text_soobheniya 'текст сообщения '.HTMLBody = sBody 'если необходим форматированные текст сообщения(различные шрифты, цвет шрифта и т.п.) .Attachments.Add = "\\msk.ru\MSK\User\Folders\00\01\yypikin1\Downloads\ff.txt" .Add ThisWorkbook.FullName ' прикрепляем файл '.Attachments.Add sAttachment 'чтобы отправить активную книгу вместо sAttachment указать ActiveWorkbook.FullName .Send 'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра End With Next lr Set objOutlookApp = Nothing: Set objMail = Nothing Application.ScreenUpdating = True End Sub |