Mail verzenden vanuit excel

Nikeo · 30 aug 2017

Hallo iedereen,

Ik zou vanuit excel automatisch mails willen gaan versturen. Nu heb ik dit reeds opgezocht maar kan nergens exact vinden wat ik nodig heb.
Ik heb een bepaalde formule gevonden maar zal dit zo daddelijk als eerste reactie plaatsen op mijn post.

De bedoeling is het volgende: ik wil op basis van 2 criteria mails gaan uitsturen:
- De eerste is dat de datum in kolom E ouder moet zijn dan de datum waarop de macro zal worden gerund.
- tweede is dat de waarde in kolom Q gelijk moet zijn aan Appointment assigned of moet leeg zijn.

Als aan deze twee criteria voldaan is dient hij te groeperen op email adres (kolom S) om vervolgens deze lijnen te versturen naar de email adressen die zich daar ook bevinden.

Ik ken de mogelijkheden niet dus ga even luidop dromen.
Kan hij vervolgens de status in (kolom Q wijzigen naar bvb Reminder sent.
en tekst toevoegen in de mail die via outlook zal worden verzonden?
Kan hij een reminder platsen in de mailbox van de agent?
Ik wil heel graag begrijpen hoe deze macro werkt omdat ik zelf ook graag mensen zou willen gaan helpen op dit forum en macro's zou willen gaan bouwen.

Alvast bedankt!

Bekijk bijlage Copy of new funnel.xlsx

Nikeo · 30 aug 2017

Formule die ik had gevonden

Sub Mail_ActiveSheet()

Dim OutApp As Object
Dim OutMail As Object
Dim strto As String
Dim strbody As String
Dim cl As Range

For Each cl In ThisWorkbook.Sheets("data and refresh").Range("M8:M20")
If cl.Value Like "?*@?*.?*" And LCase(cl.Offset(0, 1).Value) = "yes" Then
If strto = "" Then strto = stro & ";"
strto = strto & cl.Value & ";"
End If
Next cl

For Each cl In ThisWorkbook.Sheets("data and refresh").Range("O8:O12")
strbody = strbody & cl.Value & vbNewLine
Next cl

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

With OutMail
.To = strto
.CC = ""
.BCC = ""
.Subject = Range("O4").Value
.Body = strbody
'.Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Ik denk te kunnen begrijpen dat deze formule op basis van de waarde in kolom M (=Yes) mails gaat uitsturen. Maar ik kan nergens zien op basis van welke kolom hij het email adres opzoekt of andere.

Timshel · 30 aug 2017

Onderstaande code ziet er om meerdere redenen al beter uit.
1. De code staat tussen codetags en is nu ingekaderd.
2. Korter = beter. (Meestal toch)

Code:

Sub Mail_ActiveSheet()
    Dim strTo As String
    Dim Cl As Range
    Dim Sh

    Set Sh = ThisWorkbook.Sheets("data and refresh")
    For Each Cl In Sh.Range("M8:M20")
        If Cl.Value Like "?*@?*.?*" And LCase(Cl.Offset(, 1).Value) = "yes" Then
            'If strTo = "" Then strTo = strTo & ";"
            strTo = strTo & Cl.Value & ";"
        End If
    Next Cl

    With CreateObject("Outlook.Application").CreateItem(0)
        .To = strTo
        .Subject = Sh.Range("O4").Value
        .Body = Join(Application.Transpose(Sh.Range("O8:O12")), vbCrLf)
        .Display
    End With
End Sub

E-mailadressen staan volgens deze code in kolom M en moeten voldoen aan een typisch tekstmasker. "Yes" staat eventueel in de kolom ernaast (N).

Nikeo · 31 aug 2017

Timshel zei:
Onderstaande code ziet er om meerdere redenen al beter uit.
1. De code staat tussen codetags en is nu ingekaderd.
2. Korter = beter. (Meestal toch)

Code:

Sub Mail_ActiveSheet() Dim strTo As String Dim Cl As Range Dim Sh Set Sh = ThisWorkbook.Sheets("data and refresh") For Each Cl In Sh.Range("M8:M20") If Cl.Value Like "?*@?*.?*" And LCase(Cl.Offset(, 1).Value) = "yes" Then 'If strTo = "" Then strTo = strTo & ";" strTo = strTo & Cl.Value & ";" End If Next Cl With CreateObject("Outlook.Application").CreateItem(0) .To = strTo .Subject = Sh.Range("O4").Value .Body = Join(Application.Transpose(Sh.Range("O8:O12")), vbCrLf) .Display End With End Sub

E-mailadressen staan volgens deze code in kolom M en moeten voldoen aan een typisch tekstmasker. "Yes" staat eventueel in de kolom ernaast (N).

Ok dus dat wil zeggen dat de uiteindelijke formule hierop zou kunnen worden gebasseerd? Alleen moet ik dan het tekstmasker aanpassen naar een vaste waarde in een andere kolom op dezelfde rij.

Timshel · 31 aug 2017

Niet quoten graag.
Pas inderdaad de ranges aan naar jouw bestand:
Vervang M8:M20 naar de range met e-mailadressen
Vervang O4 naar de cel met het onderwerp van de mail.
Vervang O8: O12 voor de range met de mailtekst.

Nikeo · 1 sep 2017

Dus ik heb nu de formule aangepast:
Is er echter een mogelijkheid dat ik binnen deze formule de macro automatisch een subhject laat plaatsen? Ik ga er dan van uit dat ik de :
Subject = Sh.Range("R2").Value
.Body = Join(Application.Transpose(Sh.Range("Q2:Q20")), vbCrLf)
gewoon vervang naar
Subject = "Dit is een email"
Mijn email adres verschijnt echter niet in het To vak hoe komt dit? (Formule van hier boven werd niet aangepast)

Nikeo · 4 sep 2017

Aangepast formule

Sub Mail_ActiveSheet()
Dim strTo As String
Dim Cl As Range
Dim Sh

Set Sh = ThisWorkbook.Sheets("data and refresh")
For Each Cl In Sh.Range("S2:S21")
If Cl.Value Like "?*@?*.?*" And LCase(Cl.Offset(, 1).Value) = "yes" Then
'If strTo = "" Then strTo = strTo & ";"
strTo = strTo & Cl.Value & ";"
End If
Next Cl

With CreateObject("Outlook.Application").CreateItem(0)
.To = strTo
.Subject = "Hier komt het onderwerp van de mail"
.Body = Join(Application.Transpose(Sh.Range("O8:O12")), vbCrLf)
.Display
End With
End Sub

Dit is de eengepast versie van de formule:
Deze formule genereert een mail met een onderwerp en voeg de enkele lijnen toe op basis van wat er naast Body staat.

Ik weet niet of het handig is om op deze manier verder te gaan aangezien de formule die ik wens veel meer doet dan wat ik hier nu heb beschreven.
Ik vraag me dus ook af of het handig is om met deze formule voort te gaan.
Kan er iemand met wat meer kennis dan ik even kijken naar wat ik in het begin heb neergeschreven en op basis daarvan een fomrule maken of op zijn minst al zeggen of alles wat ik vraag mogelijk is om te bouwen in een macro.

JanBG · 4 sep 2017

Ook handig:

Zet je code tussen codetags (#)

Code:

Sub Mail_ActiveSheet()
Dim strTo As String
Dim Cl As Range
Dim Sh

Set Sh = ThisWorkbook.Sheets("data and refresh")
For Each Cl In Sh.Range("S2:S21")
If Cl.Value Like "?*@?*.?*" And LCase(Cl.Offset(, 1).Value) = "yes" Then
'If strTo = "" Then strTo = strTo & ";"
strTo = strTo & Cl.Value & ";"
End If
Next Cl

With CreateObject("Outlook.Application").CreateItem(0)
.To = strTo
.Subject = "Hier komt het onderwerp van de mail"
.Body = Join(Application.Transpose(Sh.Range("O8:O12")), vbCrLf)
.Display
End With
End Sub

Maakt het allemaal wat leesbaarder

Nikeo · 4 sep 2017

aha ok bedankt voor de tip!

JanBG · 4 sep 2017

Graag gedaan. Verder denk ik dat het handig is om eerst te filteren op de gegevens die je wilt mailen. Ik heb je bestand een beetje aangepast en er een filter ingezet, waarin je een bepaalde datum kunt invullen en appointment assinged.

Omdat die filter meerdere lijnen oplevert worden de email adressen niet ingevuld. Macro weet immers nog niet welk bericht naar welk email adres moet. Ga ik later naar kijken.

Code:

Sub Flter()
    
    Sheets("Blad1").Select
    Sheets("data and refresh").Range("A6").CurrentRegion.AdvancedFilter _
    Action:=xlFilterCopy, CriteriaRange:=Range("AD2:AI3"), CopyToRange:=Range _
    ("A5:AA5"), Unique:=False
    
Dim strTo As String
Dim El As Range
Dim Sh

Set Sh = ThisWorkbook.Sheets("Blad1")
For Each Al In Sh.Range("S2:S21")
If Al.Value Like "?*@?*.?*" And LCase(Al.Offset(, 1).Value) = "yes" Then
'If strTo = "" Then strTo = strTo & ";"
strTo = strTo & El.Value & ";"
End If
Next Al

With CreateObject("Outlook.Application").CreateItem(0)
.To = strTo
.Subject = "Hier komt het onderwerp van de mail"
.Body = Join(Application.Transpose(Sh.Range("O6:O100")), vbCrLf)
.Display
End With

End Sub

Code zit in dit bestand

Bekijk bijlage Kopie van Copy of new funnel.xlsm

JanBG · 4 sep 2017

Hoi,

Met deze code worden de gefilterde data in 1 e-mail gezet.

Code:

Sub Flter()
    
    Sheets("Blad1").Select
    Sheets("data and refresh").Range("A6").CurrentRegion.AdvancedFilter _
    Action:=xlFilterCopy, CriteriaRange:=Range("AD2:AI3"), CopyToRange:=Range _
    ("A5:AA5"), Unique:=False
       
    Dim objOutlook As Object
    Dim objMail As Object
    
    Dim strAan As String
    Dim strOnderwerp As String
    Dim strBericht As String

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    strAan = [S6 & ";" & S7 & ";" & S8 & ";" & S9 & ";" & S10]
    strOnderwerp = [K6 & ";" & K7 & ";" & K8 & ";" & K9 & ";" & K10]
    strBericht = [O6 & ";" & O7 & ";" & O8 & ";" & O9 & ";" & O10]
    
    With objMail
        .To = strAan
        .Subject = strOnderwerp
        .Body = strBericht
        .Display
    End With

    Set objMail = Nothing
    Set objOutlook = Nothing

End Sub

Zie ook het bestand:

Bekijk bijlage Kopie van Copy of new funnel-1.xlsm

Succes! :thumb:

Nikeo · 7 sep 2017

Hey Jan,

alvast bedankt voor jouw hulp en mijn excuses voor het late antwoord begin van de maand is steeds drukke periode hier op het werk

Deze macro is inderdaad opnieuw een stap vooruit.

Ik vroeg me echter af of het enigsinds mogelijk is om op basis van email adres te groeperen. Ik leg uit:

In sheet "data and refresh" kolom S (district_mgr) zal op een bepaald ogenblik hetzelfde email adres 2 keer voorkomen. Is er een mogelijkheid voor dat de mail wordt opgemaakt dat deze gegroepeerd worden?
Ook wou ik weten of het mogelijk is om per email adres een apparte email te maken.

JanBG · 7 sep 2017

Hallo,

Maakt niet uit.

In dit bestand kun op het tabblad interface de filtercriteria invullen (datum, appointment_state en district_mgr) en daarmee kun je dus een specifiek mailadres selecteren. Je kan meer selectiecriteria toevoegen als je wilt. Wat bedoel je precies met groeperen, dat als er meerdere mailadressen zijn er maar 1 van die adressen geselecteerd wordt?

Bekijk bijlage Kopie van Copy of new funnel-2.xlsm

Nikeo · 7 sep 2017

Hey,

nee eerder zoals in ik heb bij email adressen verschillende adressen staan.
Nu zou ik willen dat op basis van het email adres wordt gegroepeerd. Daarmee bedoel ik dat wanneer je bvb 2 appointment assigned hebt die op email adres test123@test.be staan wil ik dat de macro deze beide in dezelfde email plaatst.

Als ook in plaats van een externe filter, is er ene mogelijkheid om dit in de macro te verwerken dat enkel wanneer de waarde in kolom Q gelijk is aan Appointment assigned of leeg is hij een mail verstuurd. De andere statussen zijn immers goed en hoeven geen extra email. .

JanBG · 9 sep 2017

Hoi,
Ook een tijdje niks meer van me laten horen, maar was je niet vergeten.

Heb de code een beetje herschreven, zodat het er allemaal wat netter uitziet:

Code:

Sub Mail_ActiveSheet()

Sheets("data and refresh").Range("A6").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, CriteriaRange:=Range("AD2:AF3"), CopyToRange:=Range _
("A5:AA5"), Unique:=False

    Dim strto As String, strsubject As String, strbody As String
    Dim OutApp As Object, OutMail As Object
    Dim cell As Range
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        For Each cell In ThisWorkbook.Sheets("Interface").Range("S6:S200")
                If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 2).Value) = "yes" Then
                    If strto = "" Then strto = stro & ";"
                    strto = strto & cell.Value & ";"
                End If
            Next cell
            
        For Each cell In ThisWorkbook.Sheets("Interface").Range("O6:O200")
        strbody = strbody & cell.Value & vbNewLine
    Next
    For Each cell In ThisWorkbook.Sheets("Interface").Range("Q6:Q200")
        strsubject = strsubject & cell.Value & vbNewLine
            
    Next
        .To = strto
        .CC = ""
        .BCC = ""
        .body = strbody
        .Subject = strsubject
        .Display
    End With
        
    Set OutMail = Nothing
    Set OutApp = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Sub ClearMe()
    Range("A6").CurrentRegion.Select
    Selection.Clear
End Sub

Is dit wat je bedoelt?

JanBG · 9 sep 2017

Bestand vergeten bij te voegen....

Bekijk bijlage Kopie van Copy of new funnel-2.xlsm

HSV · 9 sep 2017

@JanBG,

Lees #5, 6, 7 en 8 nog eens door.

http://www.helpmij.nl/forum/showthr...-en-dan-snelanalyse-vba?p=5998145#post5998145

JanBG · 9 sep 2017

@HSV

Je hebt gelijk, sorry..

Nikeo · 11 sep 2017

Hey Jan,

we gaan zeker de goede richting uit. echter het email adres komt nu 3 maal in de to balk te staan. Is het mogelijk dat de macro automatisch kijkt of het email adres hetzelfde is en indien dit zo is het adres 1 keer toevoegd. Het heeft weinig nut van 3x dezelfde mail te sturen naar een persoon met exact dezelfde informatie. Als ook is het mogelijk om de filter van appointment assigned en blank in de macro te verwerken?

Alvast bedankt!

JanBG · 11 sep 2017

Hallo Nikeo,

Heb het bestand een beetje aangepast. Je kan nu filteren op lege cellen in kolom Appointment_State door in het filter "=" te kiezen. Als je in dat veld geen keuze maakt, wordt gefilterd op alle cellen in Appointment_State die NIET leeg zijn.

Ik heb ook een filter ingebouwd om te voorkomen dat email adressen meer dan 1 keer in het 'aan' vak van Outlook worden geplaatst, maar daarmee wordt de rest van het bereik (onderwerp en tekst in de mail) ook beperkt tot 1 rij en dat is denk ik niet wat je bedoelt, dus ga nog even verder kijken.

Bekijk bijlage Kopie van Kopie van Copy of new funnel-2-2.xlsm

Mail verzenden vanuit excel

Gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Verenigingslid

Inventaris

Verenigingslid

Gebruiker

Verenigingslid

Wij waarderen jouw privacy