W niektórych przypadkach mamy potrzebę wysłania wiadomości email bez rejestrowania jej w repozytorium Outlooka, lub też po prostu jesteśmy ciekawi jaki jest inny sposób do nadania wiadomości. Poniżej przedstawiona metoda jest często stosowana w programach napisanych w VisualBasicu, gdzie nie ma pewności, co do posiadania przez użytkownika klienta pocztowego lub programista danego rozwiązania chce realizować metodę komunikacji nie angażując żadnego z używanych przez klienta narzędzi pocztowych. Teraz i Ty będziesz mógł przygotować interfejs nadania wiadomości w swojej aplikacji VBA.
Option Explicit
Public Declare Function InternetGetConnectedState Lib "wininet.dll" _
(lpdwFlags As Long, ByVal dwReserved As Long) As Boolean
'--- opcje do edycji
Public Const Konto_pocztowe$ = "moje_konto@gmail.com"
Public Const Konto_haslo$ = "haslo"
Public Const Konto_serwer$ = "smtp.gmail.com"
Public Const Konto_od$ = """Nazwa wyświetlana"" <" & Konto_pocztowe & ">"
Public Const Konto_ssl As Boolean = True
Public Const Konto_auth% = 1
Public Const Konto_port% = 465 'lub 587
Sub Generuj_mail()
Dim Temat$: Temat = "Temat testowy"
Dim Odbiorca$: Odbiorca = "test@vbatools.pl"
Dim Tresc$: Tresc = "<b>Test maila </b><br>Wartość testowa: " & _
Format(range("A1"), "# ###.00")
Dim Zalaczniki$: Zalaczniki = "C:\temp\CDO - Mail_VBATools.txt,C:\temp\whatever.xls"
'---
If IsConnected Then
If Wyslij_mail(Konto_od, Temat, True, Tresc, Odbiorca, , , Zalaczniki) = False then _
MsgBox "Wiadomosć nie została wysłana!", vbExclamation, "VBATools.pl"
Beep
Else
MsgBox "Brak połączenia z internetem!", vbExclamation, "VBATools.pl"
End If
End Sub
Public Function Wyslij_mail(Od$, mTemat$, mFormatHTML As Boolean, mTresc$, mDo$, _
Optional mDw$, Optional mUdw$, Optional mZalacznik$) as Boolean
'MVP OShon from VBATools.pl
Const schema$ = "http://schemas.microsoft.com/cdo/configuration/"
Const att_schema$ = "urn:schemas:mailheader:content-disposition"
Dim konf_mail As Object, ustawienia_maila As Object, pola_schema As Variant
On Error GoTo blad
Set konf_mail = CreateObject("CDO.Message")
Set ustawienia_maila = CreateObject("CDO.Configuration")
ustawienia_maila.Load -1
Set pola_schema = ustawienia_maila.Fields
With pola_schema
.item(schema & "smtpusessl") = Konto_ssl
.item(schema & "smtpauthenticate") = Konto_auth
.item(schema & "sendusername") = Konto_pocztowe
.item(schema & "sendpassword") = Konto_haslo
.item(schema & "smtpserver") = Konto_serwer
.item(schema & "sendusing") = 2
.item(schema & "smtpserverport") = Konto_port
.item(schema & "smtpconnectiontimeout") = 10
.Update
End With
With konf_mail
Set .Configuration = ustawienia_maila
.BodyPart.Charset = "utf-8"
.To = mDo
.cc = mDw
.BCC = mUdw
.From = Od
.Subject = mTemat
If mFormatHTML = False Then .TextBody = mTresc Else _
.HTMLBody = "<html><body>" & mTresc & "</body></html>"
If mZalacznik <> "" Then
Dim x%, monitErr As Boolean, pliki As Variant
pliki = Split(mZalacznik, ",")
For x = 0 To UBound(pliki)
If FileExists(Trim(pliki(x))) = True Then
.addattachment Trim(pliki(x))
With .attachments(x + 1)
.Fields(att_schema) = "attachment; filename=" & "''" & _
Dir(Trim(pliki(x))) & "''"
.Fields.Update
End With
Else
monitErr = True
End If
Next x
End If
If monitErr Then MsgBox "Błędy dostępu do załączników!" & vbCr & _
"Poczta nie została nadana.", vbCritical, _
"VBATools.pl": Exit Function
.Send
Wyslij_mail = true
End With
Exit Function
blad:
MsgBox "Błąd: " & Err.Number & " " & Err.Description, vbCritical, "VBATools.pl"
End Function
Public Function IsConnected() As Boolean
Dim Stat As Long: IsConnected = (InternetGetConnectedState(Stat, 0&) <> 0)
End Function
Public Function FileExists(FilePath As String) As Boolean
On Error GoTo blad
If Len(FilePath) = 0 Then Exit Function
FileExists = Len(Dir(FilePath, vbDirectory Or vbHidden Or vbSystem)) > 0
Exit Function
blad:
End Function
Metodę tą uprościłem do wywołania parametrów funkcji, które to są elementarne dla jej nadania (rodzaj konta, metoda komunikacji etc.). W procedurze zawarte są zmienne jakie można z powodzeniem edytować podkładając np. treść z przygotowanego wcześniej pliku lub parametryzować listę załączników. Deklaracja API oparta na wymienionej pow. kontrolce powinna działać na każdym komputerze z systemem Windows.
Więcej...