niedziela, 17 października 2010

Wysyłanie maila za pomocą CDO

Biblioteka CDO obecna w systemie Windows świetnie nadaje się do masowego wysyłania wiadomości mailowych za pomocą za pomocą wszelakiej maści skryptów. Przykładowy skrypt wysyłający wiadomość HTML z osadzonym obrazkiem i dwoma załącznikami znajduje się w kodzie poniżej:

Option Explicit

' skracamy sobie trochę długość w ustawieniach
Private Const cdo_conf As String = "http://schemas.microsoft.com/cdo/configuration/"

Const cdoSendUsingPickup = 1 'wyslij wiadomość do katalogu z którego podejmie ją serwer
Const cdoSendUsingPort = 2 ' wysyłaj wiadomości na port serwer-a
Const cdoAnonymous = 0 'brak
Const cdoBasic = 1 'jawny tekst
Const cdoNTLM = 2 'NTLM
Const cdoRefTypeId = 0
Const cdoRefTypeLocation = 1

Sub CDO_Mail_Small_Text()

Dim strbody As String
Dim iMsg   As Object 'CDO.Message
Dim iConf  As Object 'CDO.Configuration
Dim Flds As Object

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields

' ustawienie parametrów serwera z którego korzystamy
With Flds
.Item(cdo_conf & "sendusername") = "user" 'login
.Item(cdo_conf & "sendpassword") = "xxxxxx" 'hasło
.Item(cdo_conf & "smtpserver") = "poczta.o2.pl" 'serwer SMTP
.Item(cdo_conf & "smtpserverport") = 465 ' port
.Item(cdo_conf & "sendusing") = cdoSendUsingPort 'metoda wysyłania
.Item(cdo_conf & "smtpauthenticate") = cdoBasic 'metoda uwieżytelnienia
.Item(cdo_conf & "smtpusessl") = 1 ' kodowany kanał
.Update
End With

strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"


With iMsg.Fields
' priorytet
.Item("urn:schemas:mailheader:X-MSMail-Priority") = "High" ' Dla Outlook 2003
.Item("urn:schemas:mailheader:X-Priority") = 2    ' Dla Outlook 2003 i innych np. Thunderbird-a
.Item("urn:schemas:httpmail:importance") = 2 ' Dla Outlook Express

' własny nagłówek
.Item("urn:schemas:mailheader:X-myfield") = "Email-Okay"
.Update
End With

With iMsg
Set .Configuration = iConf

' wielu odbiorców
.To = "user@gazeta.pl; user@gmail.com"
.CC = "" ' kopia
.BCC = "" ' ukryta kopia
.From = "user@o2.pl"       ' istotne wysyłamy w kontekście konkretnego konta pocztowego
.Subject = "Raport"         ' temat
.TextBody = strbody         ' wiadomość w postaci tekstu, jest niezależna od tej w HTML-u
' wiadomość w HTML-u. obrazek jako źródło ma ustawione cid:header.gif - ten sam nagłówek został dodany w kolejnej sekcji
.HTMLBody = "<img src='cid:header.gif'><br>" & Replace(strbody, vbNewLine, "<BR>" & vbNewLine)

' dodanie załącznika
.AddAttachment "d:\msg\indeksowanie.xlsm"
.AddAttachment "d:\msg\import_status.xlsx"

' dodaie obrazka wykorzystanego w wiadomości HTML
.AddRelatedBodyPart "d:\msg\header.gif", "header.gif", cdoRefTypeId

.Send ' wyślij
End With

End Sub

Jeżeli chcielibyśmy manipulować zawartością w zależności od adresata to od razu powiem – jest taka możliwość o czym opowiem w kolejnym odcinku.

1 komentarz:

  1. Witam, gratuluję zgrabnego ociosania kodu. Szkoda, że dwa lata temu nie trafiłem na tę stronę. Oszczędziłbym mnóstwo czasu :)
    ***
    Obiecał Pan kolejny odcinek dot. manipulacji danych w zależności od adresata. Nie mogę znaleźć.

    ***
    a przy okazji mam pytanie, jak zrobić z tego kodu funkcję globalną, która będzie zwracała "wynik wysyłki"?
     

    OdpowiedzUsuń