Mailcode aanpassen voor gmail

[JosEindhoven]

Goede morgen

In een bestand zit een button op het tabblad gegevens om blanco mail te versturen naar emailontvangers. De ontvangers haalt hij uit het tabblad test. De verzending gaat via outlook. Ik krijg het maar niet voor elkaar om dit via gmail te doen. Heeft er iemand een oplossing voor de code

Private Sub CommandButton4_Click()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim strto As String
Dim strbody As String
Dim cell As Range

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook
Set Destwb = ActiveWorkbook
With Destwb
FileExtStr = ".xlsx": FileFormatNum = 51
End With



TempFilePath = Environ$("temp") & ""
TempFileName = ""

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
For Each cell In ThisWorkbook.Sheets("Test").Range("i1:i450")
If cell.Value Like "?*@?*.?*" Then
If strto = "" Then strto = stro & ";"
strto = strto & cell.Value & ";"
End If
Next cell

.To = ""
.CC = ""
.BCC = strto
.Subject = ""




.Display
End With
On Error GoTo 0




Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

 

[edmoor]

Zet die code even in codetags.
Zie de link in mijn handtekening.

Voor het gebruik van bijvoorbeeld Gmail kan je CDO gebruiken:
https://www.rondebruin.nl/win/s1/cdo.htm

Overigens staan er nogal wat overbodige dingen in je code.
Er vanuit gaande dat Range("I1:I450") alleen email adressen kan bevatten is dit voldoende:

Private Sub CommandButton4_Click()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strto As String
    
    strto = Join(Application.Transpose(ThisWorkbook.Sheets("Test").Range("I1:I450").SpecialCells(xlTextValues)), ";")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ""
        .CC = ""
        .BCC = strto
        .Subject = ""
        .Display
    End With
End Sub

 

[snb]

Maar nog altijd 3 overbodige variabelen.

Private Sub CommandButton4_Click()
  with CreateObject("Outlook.Application").CreateItem(0)
     .To = "email@planet.nl"
     .BCC = Join(Application.Transpose(ThisWorkbook.Sheets("Test").Range("I1:I450").SpecialCells(2)), ";")
     .Subject = "voorbeeld"
     .Send
  End With
End Sub

 

[JosEindhoven]

Beiden bedankt voor de antwoorden

Maar hiermee kan ik nog niet verzenden met gmail

 

[edmoor]

Maar nog altijd 3 overbodige variabelen.

Tenzij Option Explicit aan staat.

Voor mailen via Gmail, zie de link die ik plaatste in #2.

Voorbeeld document voor het gebruik van CDO en GMail:
Bekijk bijlage CDOMail.xlsm

 

[snb]

@edm

Als er geen variabelen gebruikt worden doet option explicit er niet toe

 

[edmoor]

Helemaal waar uiteraard

 

[JosEindhoven]

@ snb

Met uw gebruikte code krijg ik een foutmelding

 

[edmoor]

En wat is de foutmelding?

 

[JosEindhoven]

Staat op de afbeelding in geel gearceerd

 

[edmoor]

Nee, dat is niet de foutmelding.
Dat is de regel waar de fout zich voordoet.
De foutmelding heb je in een apart berichtje op het scherm gekregen.

 

[JosEindhoven]

 

[edmoor]

Dan is er dus iets in het bereik I1:I450 niet zoals verwacht.

 

[JosEindhoven]

klopt Ed
het bereik was te groot en er stonden geen namen. Je hebt al weer gelijk