Приветствую!
Имеется вот такой скрипт по отправке писем через 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
Имеется вот такой скрипт по отправке писем через 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