[Iska]

Можно.

Код будет после предоставления образца «списка E-Mail адресов» и описания алгоритма соответствия конкретного адреса конкретному «определённому тексту».

[B1010]

Конечно, но только в личку, так как я не имею права его распространять публично.

Iska,
Не могу отправить в личку, у вас превышен лимит на сообщения)

[Iska]

Конфиденциальный текст можно заменить любым осмысленным набором символов, реальные почтовые адреса — фиктивными.

[B1010]

Без проблем, приложил к сообщению

[Iska]

Например, так:

Код:

Option Explicit

Sub SendMassMail()
    Const cdoSendUsingPort = 2
    Const cdoBasic = 1
    
    Const strSchema = "http://schemas.microsoft.com/cdo/configuration/"
    
    Dim objRange As Range
    
    If IsConnected() Then
        For Each objRange In ThisWorkbook.Worksheets.Item("Лист1").UsedRange.Columns.Item(1).Cells
            With CreateObject("CDO.Message")
                .From = "myaccount@mail.ru"
                .To = objRange.Value
                .Subject = "Some Sobject"
                .Textbody = objRange.Offset(0, 1).Value
                
                With .Configuration.Fields
                    .Item(strSchema & "smtpserver") = "smtp.mail.ru"
                    .Item(strSchema & "sendusing") = cdoSendUsingPort
                    .Item(strSchema & "smtpserverport") = 25
                    .Item(strSchema & "smtpauthenticate") = cdoBasic
                    .Item(strSchema & "sendusername") = "myaccount@mail.ru"
                    .Item(strSchema & "sendpassword") = "mypassword"
                    
                    .Update
                End With
                
                .Send
            End With
        Next
    End If
End Sub

Function IsConnected()
    Dim objSWbemObjectEx
    
    IsConnected = False
    
    For Each objSWbemObjectEx In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("SELECT * FROM Win32_PingStatus WHERE Address = 'www.google.com'")
        With objSWbemObjectEx
            If Not IsNull(.StatusCode) And .StatusCode = 0 Then
                IsConnected = True
            End If
        End With
        
        Exit For
    Next
    
    Set objSWbemObjectEx = Nothing
End Function

[B1010]

Iska,
Спасибо вам огромное, оказали большую услугу!

[B1010]

Iska,
Начал тестить, первый камень в огороде

[Iska]

Начал тестить, первый камень в огороде »

Добавьте в конфигурацию строку:

Код:

					.Item(strSchema & "smtpusessl") = True

Укажите правильный номер порта для используемого сервера с шифрованием (например, Mail.RU, Yandex — 465).

[B1010]

Iska,
Спасибо, буду проверять