Excel email verbeteren

[Springer038]

Goedemiddag,

via andere berichten op de helpmij forum kwam ik bij de website:
https://www.rondebruin.nl/win/s1/outlook/bmail9.htm

Dit heeft me al wel geholpen maar nog niet helemaal.

Ik wil graag dat wanneer de mail gestuurd moet worden dat hij ook in het excel kijkt welke gegevens daar bij horen.
Naar wie die gestuurd moet worden automatisch invullen --> Kolom D

Onderwerp van de mail--> Kolom A
Tekst in de mail: Hoeveel dagen ze nog hebben--> Kolom C

Ik hoop dat jullie mij kunnen helpen!

 

[AD1957]

En wat heb je dan geprobeerd, ik zie helemaal niets van code.

 

[AHulpje]

Vervang in de code van Ron de Bruin het volgende:

.To = Cells(r, 5)
.Subject = Cells(r, 1)
.Body = "Beste " & Cells(r, 4) & VbCrLf & "Je hebt nog " & Cells(r, 3) & " dagen over."

Hierin is r de rij uit je werkblad.

 

[Springer038]

@AD1957 Dat klopt dit heb ik weer weggehaald omdat het niet werkte. Ik heb er in gezet wat ik graag wilde zodat het duidelijk voor jullie was.


@AHulpje Wanneer ik dat doe en activeer dan opent een nieuwe mail zonder onderwerp of tekst

With xOutMail
        .To = Cells(r, 5)
        .Subject = Cells(r, 1)
        .Body = "Beste " & Cells(r, 4) & vbCrLf & "Je hebt nog " & Cells(r, 3) & " dagen over."
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

 

[AHulpje]

Je moet r wel een waarde geven natuurlijk.

 

[edmoor]

En je hebt dat 'or use .Send ook gezien?

 

[Springer038]

Je moet r wel een waarde geven natuurlijk.

Welke waarde moet ik er aan geven als ik wil dat hij naar de regel kijkt waarbij kolom C onder de 16 dagen komt?

 

[Springer038]

En je hebt dat 'or use .Send ook gezien?

Yes, maar dat vind ik niet erg dat ik de mail eerst nog even zie voordat ik hem stuur.

 

[AHulpje]

Option Explicit

Sub ZendHerinnering()
    Dim r As Integer
    r = 3
    Do While Cells(r, 3) <> vbNullString
        If Cells(r, 3) < 16 Then
            ZendMail (r)
        End If
        r = r + 1
    Loop
End Sub


Sub ZendMail(r)
    'Hier je sub die de mail verzendt invoegen
    .To = Cells(r, 5)
    .Subject = Cells(r, 1)
    .Body = "Beste " & Cells(r, 4) & vbCrLf & "Je hebt nog " & Cells(r, 3) & " dagen over."
End Sub

 

[Springer038]

Hier je sub die de mail verzendt invoegen.

Is dat dan dit gedeelte?

Mail_small_Text_Outlook()
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2"
On Error Resume Next

 

[AHulpje]

Zo dan:

Option Explicit

Sub ZendHerinnering()
    Dim r As Integer
    r = 3
    Do While Cells(r, 3) <> vbNullString
        If Cells(r, 3) < 16 Then
            ZendMail (r)
        End If
        r = r + 1
    Loop
End Sub

Sub ZendMail(r)
    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .To = Cells(r, 5)
        .CC = ""
        .BCC = ""
        .Subject = Cells(r, 1)
        .Body = "Beste " & Cells(r, 4) & vbCrLf & "Je hebt nog " & Cells(r, 3) & " dagen over."
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

 

[AD1957]

Nog niet helemaal compleet, maar dat is wat AHulpje aangaf.
edit: AHulpje was sneller.

 

[Springer038]

Ik voel me nu ontzettend dom want er gebeurt nu niks meer

Code weggehaald die er was weggehaald en die van jou er in gezet.
Nu gebeurt er niks meer als ik de cijfers verander naar onder de 16

Option Explicit

Sub ZendHerinnering()
Dim r As Integer
r = 3
Do While Cells(r, 3) <> vbNullString
If Cells(r, 3) < 16 Then
ZendMail (r)
End If
r = r + 1
Loop
End Sub

Sub ZendMail(r)
Dim OutApp As Object
Dim OutMail As Object

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

On Error Resume Next
With OutMail
.To = Cells(r, 5)
.CC = ""
.BCC = ""
.Subject = Cells(r, 1)
.Body = "Beste " & Cells(r, 4) & vbCrLf & "Je hebt nog " & Cells(r, 3) & " dagen over."
'You can add a file like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

 

[AD1957]

Werkt hier gewoon.
Hoe wordt de code getriggerd ?

 

[AHulpje]

Ik heb zo het idee dat je ervan uitgaat dat de macro automatisch gestart wordt als je de getallen in kolom C wijzigt. Als je dat wilt zul je een Worksheet_Change event moeten inbouwen.
Ik ging ervan uit dat je de macro met de hand start: Alt-F8, Enter.

 

[Springer038]

Bij de originele code was dit inderdaad het geval dat wanneer het getal wijzigde lager dan 16 dat die automatisch het mailtje werd gestart.

Edit: DIt is eigenlijk veel beter! Dan heb ik de controle er over.
Dankjewel!!