Страницы: 1
RSS
[ Закрыто ] VBA Outlook, Не могу добиться отбивки по выполненной работе
 
Приветствую!
Имеется вот такой скрипт по отправке писем через Outlook -

Проблема заключается в следующем. Не могу добиться того, что бы на листе "Комменты", на стоках которые скрипт обрабатывал в столбце "R" выпадал статус отправленного письма, то есть отправился он или нет.
Пробовал добавить строчку ThisWorkbook.Worksheets("Êîììåíòû").Range("R" & R).Value = "Status", но это бестолку, на ней же скипт и выдает ожибку.
Помогите пожалуйста.


Sub send_pismo()

'Setting up the Excel variables.
  Dim olApp As Object
  Dim olMailItm As Object
  Dim iCounter As Integer
  Dim Dest As Variant
  Dim SDest As String
 
 
  'Create the Outlook application and the empty email.
  Set olApp = CreateObject("Outlook.Application")
  Set olMailItm = olApp.CreateItem(0)
  Set OA = CreateObject("outlook.application")

 
  'Using the email, add multiple recipients, using a list of addresses in column A.
  ThisWorkbook.Worksheets("Комменты").Activate
'   MsgBox ActiveCell.Column
  If ActiveCell.Column <> 1 Then
       MsgBox "Выдели строки в столбце №Рейса!"
       Exit Sub
 
  End If
 
  Dim R As Range
 
  For Each R In Selection
       If R.Column = 1 Then
           ThisWorkbook.Worksheets("Письмо").Range("E6") = R.Value
           
           Set olApp = CreateObject("Outlook.Application")
           Set olMailItm = olApp.CreateItem(0)
           
           With olMailItm
              SDest = ThisWorkbook.Worksheets("Письмо").Range("E7").Value
              SDest1 = ThisWorkbook.Worksheets("Письмо").Range("E8").Value
              .To = SDest
              .cc = SDest1
              .Subject = ThisWorkbook.Worksheets("Письмо").Range("E9").Value
              .Attachments.Add "\\RUSSPB03FS\Work\HOME\Supply Chain\CS&L department\04 WT\01 Transport (DG)\15 Транспортная группа\06 Разбор опозданий (п.16)\Приложение 16 к Договору ТЭУ - Информирование об опоздании (шаблон).docx"
              .body = ThisWorkbook.Worksheets("Письмо").Range("E11").Value
               Set .SendUsingAccount = olMailItm.Session.Accounts.Item(1)
               On Error Resume Next
              .Send
               Application.Visible = True
               
   If Err Then
     MsgBox "E-mail to " & ThisWorkbook.Worksheets("Письмо").Range("Q" & R).Value & " was not sent", vbExclamation
   Else
     Count = Count + 1
   End If
   On Error GoTo 0
    End With
ThisWorkbook.Worksheets("Письмо").Range("R" & i).Value = "ok"
NextMail:
       Set olApp = Nothing
   
               Set olMailItm = Nothing
               Set olApp = Nothing
       End If

  Next R
  MsgBox "Электронные письма в количесве" & " " & Count & "шт." & " " & "были отправлены!", vbInformation

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

   
 
 
  'Clean up the Outlook application.
  Set olMailItm = Nothing
  Set olApp = Nothing


End Sub
 
Тема закрыта -  ни о чём.
1. Придумайте название, из которого  будет понятна задача и создайте новую.
2. Длинный код следует прятать под спойлер.
3. Зайдите в свой профиль и поменяйте отображаемое имя.
Страницы: 1
Наверх