Email küldése Gmail-ből Excel VBA-val

Korábban már posztoltam arról (itt és itt), miként lehet Excel-ből emailt küldeni Outlook-ban.
Most szintén emailt fogunk küldeni, azonban Gmail-en keresztül, mégpedig a CDO (Collaboration Data Objects) segítségével.

A CDO használatával tudjuk az email-es lehetőséget alkalmazni VBA-ban, illetve az email szolgáltató SMTP szerverét használni. Bővebben a CDO-ról itt.

Mielőtt futtatjuk a lenti makrót, két dolgot kell megtennünk:

1. hozzáadjuk a CDO-t a VBA szerkesztõben:

Tools -> References -> pipát betenni a “Microsoft CDO for Windows 2000 Library” elé, majd OK

2. Ez általában akkor kell, ha nincs két lépcsős azonosítás beállítva Gmail-ben:

Céges környezetben: ha szükséges, a lenti opció bekapcsolása előtt egyeztess az IT-vel.

az alábbi linken BEKAPCSOLNI a “Kevésbé biztonságos alkalmazások hozzáférése” opciót:

https://myaccount.google.com/security?pli=1#connectedapps

A linkre való kattintás után be kell jelentkeznünk a Gmail-es névvel + jelszóval, majd a “Biztonság” szekción belül a “Kevésbé biztonságos alkalmazások hozzáférése” rész alatti “Hozzáférés engedélyezése (nem javasolt)”-ra kattintani:

Végül a “Kevésbé biztonságos alkalmazások engedélyezése”-t kapcsoljuk be:

Ezt a kód lefutása után érdemes ismét kikapcsolni, ha eredetileg is úgy volt.

Ezt követően az alábbi makrót másoljuk be egy modulba és futtassuk le:

Sub EmailKuldeseExcelbolGmailre()

'készítette Tulner Roland (xlmotyo.hu)

'Inspiráció (angol): _
https://www.launchexcel.com/sending-e-mails-from-gmail-and-outlook-using-excel-vba/#gmail

'email küldése Excelbõl: Gmail-es emailrõl tetszõleges emailre. Elsõ két lépést megcsinálni, mielõtt futtatod a makrót!

'----------------------------------------------------------------------------------------------------------------------
'LÉPÉSEK

'1. VBA szerkesztõben: Tools -> References -> pipát betenni a "Microsoft CDO for Windows 2000 Library" elé, majd OK
'[CDO ismertetõ az alábbi link bevezetõjében (angol): _
https://www.exceltrainingvideos.com/tag/using-cdo-to-send-email-automatically/]

'2. Az alábbi linken BEKAPCSOLNI a "Kevésbé biztonságos alkalmazások hozzáférése" opciót Gmail-ben: _
    https://myaccount.google.com/security?pli=1#connectedapps

'3. ezen makró ("Sub SendGmail") futtatása

'4. Az alábbi linken KIKAPCSOLNI a "Kevésbé biztonságos alkalmazások hozzáférése" opciót Gmail-ben: _
    https://myaccount.google.com/security?pli=1#connectedapps
'----------------------------------------------------------------------------------------------------------------------

If MsgBox( _
"Makró futtatása elõtt:" & vbNewLine & vbNewLine & _
"VBA szerkesztõben betetted a pipát a 'Microsoft CDO for Windows 2000 Library' elé?" & vbNewLine & _
"+" & vbNewLine & _
"Bekapcsoltad a 'Kevésbé biztonságos alkalmazások hozzáférése' opciót Gmail-ben?", vbYesNo + vbQuestion + _
vbDefaultButton2, "Figyelmeztetés") = vbNo Then Exit Sub

'CDO objektum létrehozása (korai kötés)
Dim Mail As CDO.Message, fromGmailCim As String, toEmailCim As String, Jelszo As String
Set Mail = New CDO.Message

'SSL hitelesítés engedélyezése
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

'az SMTP hitelesítés engedélyezése (érték "TRUE"-ra vagyis 1-re állítása)
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1

'az SMTP szerver és a port adatok beállítása
'ezeket a részleteket az adott Gmail fiók Beállítások oldalán lehet megkapni ("Átirányítás és POP/IMAP" fülön)
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"smtp.gmail.com"
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Mail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

'Gmail fiók belépési adatainak megadása
fromGmailCim = Application.InputBox("Add meg a Gmail-es címed, ahonnan a levelet küldöd!", , "XXX@gmail.com", , , , , 2)
Jelszo = Application.InputBox("Add meg a jelszót a " & fromGmailCim & " -hoz!", "", , , , , , 2)
toEmailCim = Application.InputBox("Add meg a cél email címet, mely nem csak Gmail-es lehet!", , "XXX@YYY.com", , , , , 2)

Mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = fromGmailCim
Mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Jelszo

'Konfigurációs mezõk frissítése
Mail.Configuration.Fields.Update

'Email opciók beállítása
With Mail
   .Subject = "Gmail-es email küldés_teszt_05"
   .From = fromGmailCim
   .To = toEmailCim
   '.CC = "user2@gmail.com"
   '.BCC = "user3@blabla.com"
   .TextBody = "Teszt email szövege"
   '.AddAttachment ("Fájl teljes elérési útjának megadása") 'csatolmány; frissíteni a fájl elérési útját
End With

'email küldése
On Error GoTo Vege
Mail.Send
MsgBox "Email sikeresen elküldve a(z) " & fromGmailCim & " -ról a(z) " & toEmailCim & " -ra.", vbInformation, "Gratulálok!"
On Error GoTo 0

Exit Sub

Vege:
MsgBox _
"Hiba lehetséges okai:" & vbNewLine & vbNewLine & _
"1. Nem megfelelõ Gmail-es email cím (ahonnan küldöd a levelet). Minta: XXXXXXXXXX@gmail.com" & vbNewLine & vbNewLine & _
"2. Gmail-es emailhez tartozó jelszó téves." & vbNewLine & vbNewLine & _
"3. Cél email cím nem létezik." & vbNewLine & vbNewLine & _
"4. Bekapcsoltad a 'Kevésbé biztonságos alkalmazások hozzáférése' opciót Gmail-ben itt?" & vbNewLine & vbNewLine & _
"https://myaccount.google.com/security?pli=1#connectedapps" & vbNewLine & vbNewLine & _
"Ha nem, kapcsold be ás futtasd a makrót újra. A link a makróból is kimásolható, pl. a 'LÉPÉSEK' szekció 2. pontjából." _
, vbCritical, "Hiba"

End Sub

Sub EmailKuldeseExcelbolGmailre()

'készítette Tulner Roland (xlmotyo.hu)

'Inspiráció (angol): _

https://www.launchexcel.com/sending-e-mails-from-gmail-and-outlook-using-excel-vba/#gmail

'email küldése Excelbõl: Gmail-es emailrõl tetszõleges emailre. Elsõ két lépést megcsinálni, mielõtt futtatod a makrót!

'----------------------------------------------------------------------------------------------------------------------

'LÉPÉSEK

'1. VBA szerkesztõben: Tools -> References -> pipát betenni a "Microsoft CDO for Windows 2000 Library" elé, majd OK

'[CDO ismertetõ az alábbi link bevezetõjében (angol): _

https://www.exceltrainingvideos.com/tag/using-cdo-to-send-email-automatically/]

'2. Az alábbi linken BEKAPCSOLNI a "Kevésbé biztonságos alkalmazások hozzáférése" opciót Gmail-ben: _

https://myaccount.google.com/security?pli=1#connectedapps

'3. ezen makró ("Sub SendGmail") futtatása

'4. Az alábbi linken KIKAPCSOLNI a "Kevésbé biztonságos alkalmazások hozzáférése" opciót Gmail-ben: _

https://myaccount.google.com/security?pli=1#connectedapps

'----------------------------------------------------------------------------------------------------------------------

If MsgBox( _

"Makró futtatása elõtt:" & vbNewLine & vbNewLine & _

"VBA szerkesztõben betetted a pipát a 'Microsoft CDO for Windows 2000 Library' elé?" & vbNewLine & _

"+" & vbNewLine & _

"Bekapcsoltad a 'Kevésbé biztonságos alkalmazások hozzáférése' opciót Gmail-ben?", vbYesNo + vbQuestion + _

vbDefaultButton2, "Figyelmeztetés") = vbNo Then Exit Sub

'CDO objektum létrehozása (korai kötés)

Dim Mail As CDO.Message, fromGmailCim As String, toEmailCim As String, Jelszo As String

Set Mail = New CDO.Message

'SSL hitelesítés engedélyezése