Waarden uit cel in E-mail body, als andere waarde voldoet aan eis.

[inMilu]

Beste gebruikers,

Ben me heel de dag al aan het rot zoeken maar krijg het helaas niet voor elkaar.

Ik heb een Excel bestand dat als volgt is opgebouwd:
A: Kortingscode
B: Kortingspercentage
C: Leverancier
D: Assortiment
E: Laatst gewijzigd

Nu heb ik de code ( deels gerecycled uit een vorig topic dat ik had ) om automatisch een e-mail te versturen wanneer de datum in kolom E gelijk is aan vandaag (Heb ik dat zo correct gedaan?). Wat ik graag zou willen toevoegen in de body is dat hij nu de waardes toevoegt van alle regels waar in kolom E de datum van vandaag staat. Indien mogelijk van A t/m D.

Mocht ik dus meerdere kortingscodes aanpassen op 1 dag, dan wil ik dat ze allemaal worden weergegeven in de e-mail.

De code tot dusverre (Workbook_Open wordt nog een sub dat hij uitvoert bij het opslaan van het Excel, en niet bij het openen):

Private Sub Workbook_Open()

Dim cl As Range
        With CreateObject("Outlook.Application").CreateItem(0)
         For Each cl In Sheets(1).Columns(5).SpecialCells(2)
          If IsDate(cl) Then
           If cl.Value = Date Then
              .To = "mijnemail@mijnemail.com"
              .Subject = "Wijziging van korting."
              strBody = "Beste collega's" & vbCrLf & vbCrLf & "Een of meerdere CMC codes zijn van korting gewijzigd." & vbCrLf & vbCrLf & "Dit betreft:" & vbCrLf & "Hier moeten alle regels van A tot D komen te staan waar in kolom E de datum van vandaag staat"
            

                .Body = strBody
             
              
              
              
              
              .display
              '.send
             End If
           End If
        Next cl
    End With

   'ThisWorkbook.Close 1
End Sub

Mocht er iemand zijn die mij hierbij kan helpen dan graag!

Alvast bedankt

 

[VenA]

Je kan deze eens proberen.

En vervolgens een beetje aanpassen naar eigen wensen. De datum heb ik er even in laten staan ter controle. Als de datum in jouw bestand als formule staat =VANDAAG() dan zal je de specialcells aan moeten passen. Of een voorbeeldje plaatsen met hoe het geheel in elkaar steekt.

Sub VenA()
For Each cl In Blad1.Columns(5).SpecialCells(2, 1)
    If cl = Date Then
        c00 = c00 & cl.Offset(, -4) & " " & cl.Offset(, -3) & " " & cl.Offset(, -2) & " " & cl.Offset(, -1) & " " & cl & Chr(10)
    End If
Next cl
MsgBox c00
End Sub

 

[HSV]

Of:

 c00 = c00 & Join(Application.Index(cl.Offset(, -4).Resize(, 5).Value, 0)) & vbLf

 

[inMilu]

Beide bedankt voor het reageren, helaas is mijn VBA kennis te gering om jullie tips toe te passen.

Is dit een aparte sub die ik ipv mijn sub moet gebruiken, of is dit een aanvulling ( Moet het in een module? ).

Heb even een test bestand in de bijlage gezet. Het e-mail maken op basis van een datum die gelijk is aan vandaag werkt, nu nog de informatie uit die regel erbij in de tekst ^^ Ik heb namelijk geen MsgBox nodig die mij verteld welke regels in kolom F de datum van vandaag hebben, ik wil graag dat dit toegevoegd wordt aan de .body van het mailtje.


Bekijk bijlage TestbestandKortingen.xlsm

 

[VenA]

De msgbox staat er om te kijken of c00 de juiste waarde krijgt. Met het & teken kan je verschillende variabelen aan elkaar koppelen je krijgt dan zoiets.

Private Sub Workbook_Open()
For Each cl In Blad1.Columns(5).SpecialCells(2, 1)
    If cl = Date Then
        c00 = c00 & cl.Offset(, -4) & " " & cl.Offset(, -3) & " " & cl.Offset(, -2) & " " & cl.Offset(, -1) & " " & Chr(10)
        'c00 = c00 & Join(Application.Index(cl.Offset(, -4).Resize(, 4).Value, 0)) & vbLf
    End If
Next cl
strBody = "Beste collega's" & vbCrLf & vbCrLf & "Een of meerdere CMC codes zijn van korting gewijzigd." & vbCrLf & vbCrLf & "Dit betreft:" & vbCrLf [COLOR="#FF0000"][B]& c00[/B][/COLOR]
With CreateObject("Outlook.Application").CreateItem(0)
    .To = "mijnemail@mijnemail.com"
    .Subject = "Wijziging van korting."
    .Body = strBody
    .display '.send
End With
'ThisWorkbook.Close 1
End Sub

 

[inMilu]

Hoi Vena,

Excuses voor de late reactie. Dit werkt inderdaad perfect! Bedankt voor de hulp, ga ik er nog even verder mee stoeien om een aantal dingen toe te voegen. Bedankt voor de hulp!

 

[inMilu]

Heb even het topic weer als onopgelost gemarkeerd omdat ik op nog een klein probleempje stuitte, hopelijk weet iemand mij hier nog mee te helpen.

Aangezien ik wil dat de macro gaat runnen wanneer je het bestand opslaat, dus na een wijziging, ziet de code er momenteel zo uit:

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Private Sub Workbook_Open()
For Each cl In Blad1.Columns(6).SpecialCells(2, 1)
    If cl = Date Then
        c00 = c00 & cl.Offset(, -4) & " " & cl.Offset(, -3) & " " & cl.Offset(, -5) & " " & cl.Offset(, -2) & " " & cl.Offset(, -1) & " " & Chr(10)
        'c00 = c00 & Join(Application.Index(cl.Offset(, -4).Resize(, 4).Value, 0)) & vbLf
    End If
Next cl
strBody = "Beste collega's" & vbCrLf & vbCrLf & "Een of meerdere CMC codes zijn van korting gewijzigd." & vbCrLf & vbCrLf & "Dit betreft:" & vbCrLf & c00
With CreateObject("Outlook.Application").CreateItem(0)
    .To = "mijnemail@mijnemail.com"
    .Subject = "Wijziging van korting."
    .Body = strBody
    .display '.send
End With
'ThisWorkbook.Close 1
End Sub

Het aanmaken van de e-mail met de gegevens uit die rij wanneer een datum gelijk is aan vandaag werkt perfect. Wat nu het wel geval is, is dat wanneer ik het bestand opsla zonder dat er een datum in kolom F staat die gelijk is aan vandaag hij alsnog een e-mail wilt versturen (Maar dan zonder enige gegevens uit de c00, wel de rest van de body).

Hoe kan ik het zo maken dat die e-mail alleen aangemaakt wordt wanneer er dus in kolom F een datum gelijk is aan vandaag, de datum is overigens een waarde en geen formule.

Hopelijk heeft iemand het antwoord, dacht namelijk dat het al zo werkte tot ik verder aan het testen was vandaag.

Alvast bedankt voor de reacties!

 

[VenA]

Dan moet je even toetsen of c00 wel een waarde heeft

If c00 = "" then exit sub
strBody = ...............

 

[inMilu]

VenA, wederom bedankt!

Ik dacht al dat het zo moest, had alleen de plek niet juist waar het te zetten. Dat vind ik vaak nog lastig omdat ik niet precies weet hoe excel de regels leest.
Het werkt zo inderdaad! Super bedankt!

 

[VenA]

Je kan zelf bekijken hoe excel de regels 'leest' door in de VB editor op <F8> te drukken. Onder foutopsporing staan nog wat meer opties.