Verzenden email vanuit Excel met Concept tekst in email op nemen

[Pieter671]

Beste forumlid,

Ik wil graag vanuit Excel een email laten versturen (VBA).
Naast de invulling van het email-adres en het onderwerp wil ik ook graag een concept tekst opnemen.

vb

Geachte heer/mevrouw,

Dit is de eerste zin.
Dit is de tweede zin.

Heeft iemand van jullie een idee hoe dit is in te vullen is?

Sub verzenden_email()
    
    Dim adres As String
    Dim onderwerp As String
          
    adres = "emailadres@provider.nl"
    onderwerp = "Onderwerp van de email"
         
    Application.Dialogs(xlDialogSendMail).Show arg1:=adres, arg2:=onderwerp
    
    
End Sub

 

[Nelis1]

hier het betere leenwerk:

https://www.rondebruin.nl/win/s1/outlook/mail.htm


ik heb zelf vanuit deze "open source"meerdere mails in VBA opgesteld.

dit is een voorbeeld van hoe ik de mail ingericht heb ( met mijn beperkte VBA kennis)

Sub Email_VBA()

Dim eBody As String
Dim todAY As Date
Dim tod As Date

eBody = "Goedemorgen allemaal," & "<BR><BR>" & "Rapportage voor deze week staat klaar." & "<BR><BR>" & "Priorisering:" & "<BR>" & "1. CLP" & "<BR>" & "2. Hals" & "<BR>" & "3. QB01" & "<BR>" & "4. Bio" & "<BR>" & "<BR><BR>" & "<A HREF=""file://" & ActiveWorkbook.FullName & _
""">Link report</A>" & "<BR><BR><BR>" & "Mvg" & "<BR>" & "Japie"

Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.SentOnBehalfOfName = "PIT"
.to = ""
.CC = ""
.BCC = ""
.Subject = "Artikel Classificaties - Week " & Sheets("Weekly Feed Clusters").Range("B4").Value
.Display
.htmlBody = eBody
.Attachments.Add ("C:")

End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True

line1:
End Sub[CODE]

[/CODE]

 

[Pieter671]

De code blijft hangen op:

Set OutApp = CreateObject("Outlook.Application")

Het is de bedoeling dat de standaard ingestelde email cliënt wordt geopend met header info en een aanzet van de mail (tekst)
Dus niet alleen Outlook?

Inmiddels al geleerd dat

Application.Dialogs(xlDialogSendMail).Show

maar een drie-tal argumenten kan hebben en dat bij deze syntax geen email tekst kan worden opgenomen.

Is er een andere oplossing?

 

[snb]

@niels

kun je nog even code tags rondom de VBA-code zetten ?

@pieter

zie: http://www.snb-vba.eu/VBA_Excelgegevens_mailen.html

 

[edmoor]

"blijft hangen" zegt helemaal niks over de oorzaak. Krijg je een foutmelding?
De code is overigens alleen voor Outlook.
Een andere client is niet mogelijk tenzij er een SDK voor beschikbaar is die je dan zal moeten leren kennen.

Wel kan je iedere willekeurige SMTP server gebruiken door te mailen via CDO.
Bijgaand een voorbeeld voor het gebruik van de Gmail SMTP server.
Je dient dan in het Gmail account wel minder veilige apps toe te staan:
https://support.google.com/accounts/answer/6010255?hl=nl

Het CDO voorbeeld:

Sub CDOmail()
    Dim iMsg As Object
    Dim iConf As Object
    Dim Flds As Variant
    Dim Schema As String

    Dim SMTPsendusing As Byte
    Dim SMTPauthenticate As Byte
    Dim SMTPserver As String
    Dim SMTPserverport As Integer
    Dim SMTPusessl As Boolean
    Dim SMTPusername As String
    Dim SMTPpassword As String
    Dim SMTPconnectiontimeout As Integer
    
    Dim msgTO As String
    
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

    SMTPsendusing = 2
    SMTPauthenticate = 1
    SMTPserver = "smtp.gmail.com"
    SMTPserverport = 465
    SMTPusessl = True
    SMTPusername = "account@gmail.com"
    SMTPpassword = "WachtwoordVanDatAccount"
    SMTPconnectiontimeout = 10
    
    msgTO = "geadresseerde@gmail.com"
    
    Schema = "http://schemas.microsoft.com/cdo/configuration/"
    iConf.Load -1   [COLOR="#008000"]'zet CDO standaard instellingen[/COLOR]
    Set Flds = iConf.Fields
    With Flds
        .Item(Schema & "sendusing") = SMTPsendusing
        .Item(Schema & "smtpauthenticate") = SMTPauthenticate
        .Item(Schema & "smtpserver") = SMTPserver
        .Item(Schema & "smtpserverport") = SMTPserverport
        .Item(Schema & "smtpenablessl") = SMTPusessl
        .Item(Schema & "smtpusessl") = SMTPusessl
        .Item(Schema & "smtpsendtls") = SMTPusessl
        .Item(Schema & "sendusername") = SMTPusername
        .Item(Schema & "sendpassword") = SMTPpassword
        .Item(Schema & "smtpconnectiontimeout") = SMTPconnectiontimeout
        .Update
    End With

    With iMsg
        Set .Configuration = iConf
        .To = msgTO
        .CC = ""
        .BCC = ""
        .From = SMTPusername
        .Subject = "Het onderwerp"
        .TextBody = "De mail tekst"
        [COLOR="#008000"]'.AddAttachment "C:\Map\Bestand.pdf"[/COLOR]
        .Send
    End With

    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing
End Sub

 

[Nelis1]

@snb - aangepast :thumb:

 

[snb]

Dat is het beter leeswerk voor de helpers.:thumb: