Trimitere Email fara Outlook

[Catalin B.]

Iata si codul pentru trimitere email utilizand CDO -Collaboration Data Object:

Cod: Selectaţi tot

Option Explicit
Sub sendmail()

    Dim iMsg As Object
Dim iConf As Object
Dim strbody As String
 Dim Flds As Variant

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1
Set Flds = iConf.Fields
With Flds
.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = ActiveSheet.Cells(2, "I").Text
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = ActiveSheet.Cells(3, "I").Text
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
.Update
End With


With iMsg
Set .Configuration = iConf
.To = ActiveSheet.Cells(5, "B").Text
.From = ActiveSheet.Cells(4, "B").Text
.Subject = ActiveSheet.Cells(3, "B").Text
.TextBody = ActiveSheet.Cells(6, "B").Text
'.AddAttachment "c:/temp/readme.txt"
.Send
End With

Set iMsg = Nothing
Set iConf = Nothing
End Sub

Avantaje:
1: Nu conteaza ce program de email este instalat (utilizeaza doar serverul SMTP).
2: Nu conteaza nici versiunea de office (97…2013)
3:Se poate trimite un range sau un sheet in email body, (unele programe de email nu pot face asta)
.TextBody = "file://NumePC/NumeFolder/TestFile.xls"
Daca numele fisierului contine spatii ("Test File.xls"), acestea trebuie inlocuite cu %20 :
.TextBody = "file://NumePC/NumeFolder/Test%20File.xls"
4: Se pot trimite orice tip de fisiere (Word, PDF, PowerPoint, TXT )
5: la trimitere, nu apar avertizari de securitate, ceea ce e un avantaj la trimiterea unui numar mai mare de mesaje.

Exemplul e creat pentru utilizarea serverului SMTP Google : "smtp.gmail.com", dar se poate introduce adresa serverului propriu, daca exista

[Bejenaru Cornel]

Buna seara! Imi puteti spune, va rog, ce nu ii convine? Mai trebuie sa setez ceva in prealabil? Repet, la VBA sunt tufa...

[Catalin B.]

Sunt cel putin 2 motive pentru care nu a mers sau nu ar fi mers: eroarea din imagine apare daca lipseste sau nu e inregistrat acel cdosys.dll:
-deschide un command prompt cu Run as administrator, si lanseaza comanda: regsvr32 "c:\windows\system32\cdosys.dll" (asta daca nu e inregistrat); daca lipseste, incearca sa descarci si sa instalezi CDO
Oricum nu ar fi mers, pentru ca in casetele I2 si I3 nu ai introdus datele de acces pentru un cont gmail valid. Daca ai un alt server de mail, trebuie modificat in cod adresa serverului, din smtp.gmail.com in smtp.itlearning.ro de exemplu...; apoi, in I2 si I3 introduci user si parola.
Din imaginea anexata, nu se poate vedea daca ai introdus o adresa de destinatie valida sau a ramas cea din exemplul anexat de mine
Succes!

[Bejenaru Cornel]

Stiu ca e putin tardiv... Navigam prin forumuri si am vazut restanta aceasta de raspuns. A mers, multumesc!