Wysyłanie wiadomosci e-mail z VBA

Collaboration Data Objects (CDO) to biblioteka umożliwiająca wysyłanie wiadomosci e-mail. Była dedykowana dla Windows 2000 ale działa do dziś 🙂

Kod oczywiście wymaga poprawek w zakresie adresów e-mail jak i danych serwera wysyłającego pocztę. Niektóre serwery (np Gmail) mogą wymagać dodatkowych ustawień dla użycia przez CDO

'Wymaga biblioteki Microsoft CDO for Windows 2000 Library
 
Sub WyslijMail_CDO()
    Dim Wiadomosc As CDO.Message
    Dim Konfiguracja As CDO.Configuration
 
    Set Wiadomosc = New CDO.Message
    Set Konfiguracja = New CDO.Configuration
 
    Const ADRES_KONFIGURACJI As String = "http://schemas.microsoft.com/cdo/configuration/"
 
    Konfiguracja.Load cdoDefaults
 
    With Konfiguracja.Fields
        .Item(ADRES_KONFIGURACJI & "sendusername") = "login"          'login
        .Item(ADRES_KONFIGURACJI & "sendpassword") = "hasło"          'hasło
        .Item(ADRES_KONFIGURACJI & "smtpserver") = "poczta.o2.pl"     'serwer SMTP
        .Item(ADRES_KONFIGURACJI & "smtpserverport") = 465            'port
        .Item(ADRES_KONFIGURACJI & "sendusing") = cdoSendUsingPort    'metoda wysyłania
        .Item(ADRES_KONFIGURACJI & "smtpauthenticate") = cdoBasic     'metoda autentykacji
        .Item(ADRES_KONFIGURACJI & "smtpusessl") = 1                  'kodowany kanał
        .Update
    End With
 
    Set Wiadomosc.Configuration = Konfiguracja
 
    Wiadomosc.From = "adres1@o2.pl"
    Wiadomosc.To = "adres2@gmail.com"
    Wiadomosc.Subject = "Test CDO"
    Wiadomosc.TextBody = "Hej" & vbNewLine & "To jest test biblioteki CDO" & _
        vbNewLine & vbNewLine & "Pozdrawiam" & vbNewLine & "Darek"
 
    Wiadomosc.Send
 
End Sub