[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