Mail versturen op datum meerder kolommen

[HWV]

Beste,

Mijn bestand waar ik bij houd welke documenten we hebben binnen gekregen en wanneer deze verlopen voor onze BRC wil ik zo inrichten, dat als er een document over 30 dagen vervalt er een mail verzonden wordt naar onze leverancier.
Aangezien we hier over veel artikelen praten zou het mooi zijn als dit in één mail naar de leverancier gaat met de verschillende certificaten.

Ik heb een poging gewaagd in het bestand zoals bijgevoegd, maar deze werkt niet en pakt maar 1 kolom :-(

Bekijk bijlage Voorbeeld_mail_leverancier_documenten.xlsm

- Per kolom F, G, H. I, j, K, L, N, O en P moet er gekeken worden of er een datum verlopen is.
- Als deze gevonden is moet dit van de artikelen verzameld worden en dan in de body van de mail gezet worden richting de leverancier en welk certificaat/document per regel verwacht wordt
- in kolom Q aangeven dat de mail verzonden is naar de leverancier, om deze niet dubbel te sturen

In tabblad Leverancier daar staan de nummer, naam en mail adres van de leverancier

Ik hoop dat ik op weg geholpen kan worden want ik loop vast, en misschien is het ook niet mogelijk.
HWV

 

[Timshel]

Er is iets geks aan de hand met de data in je spreadsheet: de jaartallen bestaan uit 5 cijfers.

 

[Sven1985]

Denk dat je best Access neemt met de optie mail merge .

 

[HWV]

Niet bekend met Access, en bestand op datum gezet

Beste,

Ik heb bestand bekeken en ik de datum nu op eigenschap datum gezet, deze stond op een aangepaste datum.

Bekijk bijlage Voorbeeld_mail_leverancier_documenten.xlsm

Met Access ben ik niet bekend, en excel werkt iedereen mee bij ons dus mijn voorkeur zou daar naar uit gaan.

Is er een mogelijkheid om het geen te benaderen wat ik vraag of is er een makkelijke manier hiervoor die ik over het hoofd zie!

HWV

 

[snb]

Begin in ieder geval alle samengevoegde cellen in het werkblad te verwijderen ter voorkoming van onbegrijpeijke resultaten.

Verwijder ook de lege kolom M, dat levert meer problemen op dan het oplost.

Sub M_snb()
   sn = Sheets("Documentenregistratie").Cells(1).CurrentRegion
   
   For j = 2 To UBound(sn)
      For jj = 6 To 14
         If sn(j, jj) <> "" And DateDiff("d", Date, sn(j, jj)) < 31 Then c00 = c00 & vbLf & sn(j, 1) & "_" & sn(j, 4) & "_" & sn(1, jj)
      Next
   Next
   
   MsgBox c00
End Sub

 

[HSV]

Het resultaat wat je graag wil ontgaat me een beetje in het verhaal.
Zie maar of het hiermee lukt.

Sub Mail_on_Date()
Dim Rng As Range, cl As Range, cll As Range
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
   
Set Rng = Range("F12:Q" & Cells(Rows.Count, 1).End(xlUp).Row)
      
For Each cl In Range(Rng.Columns(12).Address)
 If cl = "" Then
     For Each cll In Cells(cl.Row, 6).Resize(, 11)
       If IsDate(cll) And cll < Date + 31 Then
         cl = "Verstuurd"
    
        
'Subject string
    EmailSubject = "Aanvraag productspecificatie cq Certificaten"
    EmailSendTo = Sheets("leverancier").Cells(Application.Match(Cells(cll.Row, 4), Sheets("Leverancier").Columns(1), 0), 3)
    
    MailBody = "Beste," & vbNewLine & vbNewLine _
    & "Wij missen nog de volgende documenten, " & Cells(cll.Row, 1) & " " & Cells(cll.Row, 2) _
    & vbNewLine & vbNewLine & "Met vriendelijke groet," _
    & vbNewLine & vbNewLine & "Henk"


'Send Mail
        With CreateObject("Outlook.Application").CreateItem(0)
            .Subject = EmailSubject
            .To = EmailSendTo
            '.bcc
            .body = MailBody
            .Display
            '.send
        End With
    End If
  Next cll
 End If
 Next cl


End Sub

 

[HWV]

Per leverancier in een mail en welke certificaten-Documenten

Beste,

Bedankt voor de reactie`s. Ik heb het geprobeerd zo goed mogelijk uit te leggen maar dus niet.
Ik heb nu de code ingevoerd van HVS en dit gaat goed, maar is nog niet helemaal wat ik bedoel.

- Het zou per leverancier in één mail moeten komen
- Aangeven om welke Certificaten -Documenten het gaat per artikelregel, en het liefst per document wanneer deze vervalt
- Datum van vandaag - 4 weken

voorbeeld mail, van hoe het er ongeveer uit moet komen te zien: (suggestie`s altijd welkom :d)

info@leverancier1.nl
Aanvraag productspecificatie cq Certificaten

Beste,

Wij missen nog de volgende documenten,

103010 Omschrijving 1,
Declaration of Compliance, vervaldatum 27-03-2016
ISO Certificaat, vervaldatum 27-03-2016
BRC / IOP Certificaat, vervaldatum 27-03-2016

1030256 Omschrijving 5,
Declaration of Compliance, vervaldatum 27-03-2016
ISO Certificaat, vervaldatum 27-03-2016
BRC / IOP Certificaat, vervaldatum 27-03-2016

Met vriendelijke groet,
Henk

Doel wat ik wil bereiken:
Als er één van de documenten dreigt te vervallen dat we dan bij de leverancier nieuwe geldige documenten gaan opvragen vandaar 4 weken voor vervallen van de einddatum.

HWV
Bekijk bijlage Voorbeeld_mail_leverancier_documenten.xlsm

 

[HWV]

Sorry niet goed gekeken

Bekijk bijlage Voorbeeld_mail_leverancier_documenten_1.xlsm

Ik had niet goed gelezen het bericht van SNB, en ben daar mee an de gang gegaan en ingebouwd dat hij het per mail gaat verzenden.

Sub Mail_on_Date1()
Dim Rng As Range, cl As Range, cll As Range
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
   
   sn = Sheets("Documenten_registratie").Cells(1).CurrentRegion
   
   For j = 2 To UBound(sn)
      For jj = 6 To 14
         If sn(j, jj) <> "" And DateDiff("d", Date, sn(j, jj)) < 31 Then C00 = C00 & vbLf & sn(j, 1) & "  " & sn(j, 2) & "  " & vbNewLine & sn(j, 4) & "  " & sn(j, 5) & vbNewLine & "" & sn(1, jj) & vbNewLine
      Next
   Next
        
'Subject string
    EmailSubject = "Aanvraag productspecificatie cq Certificaten"

'Send Mail
        With CreateObject("Outlook.Application").CreateItem(0)
            .Subject = EmailSubject
            .To = "info@test.nl"
            '.Bcc =
            .body = "Beste," & vbNewLine & vbNewLine _
    & "Wij missen nog de volgende documenten : " & vbNewLine & C00 & vbNewLine & "Met vriendelijke groet," _
    & vbNewLine & vbNewLine & "Henk"

            .Display
            '.send
        End With
End Sub

Dit werkt goed zoals ik het wil, enkel het per leverancier verzamelen en in een mail stoppen per leverancier wil niet lukken!

Tevens ben ik ook nog bezig om in Kolom P het voor elkaar te krijgen als deze als verzonden is dat daar dan verzonden staat, en dat hij met opnieuw versturen hier rekening mee houd.

HWV

 

[VenA]

Probeer het zo eens. De mailprocedure kan je zelf denk ik wel inpassen.

Sub VenA()
ar = Sheets("Documenten_registratie").[A11].CurrentRegion.Resize(, 17)
For j = 12 To UBound(ar)
    If InStr(1, c00, ar(j, 5)) = 0 Then c00 = c00 & "|" & ar(j, 5)
Next j

For j = 0 To UBound(Split(Mid(c00, 2), "|"))
    For jj = 12 To UBound(ar)
        For jjj = 6 To 16
            If ar(jj, 5) = Split(Mid(c00, 2), "|")(j) And ar(jj, jjj) <> "" And DateDiff("d", Date, ar(jj, jjj)) < 28 Then
                If Len(c01) = 0 Or InStr(1, c01, ar(jj, 1)) = 0 Then
                    c01 = c01 & Chr(10) & Chr(10) & ar(jj, 1) & " " & ar(jj, 2) & "," & Chr(10) & ar(1, jjj) & ", vervaldatum " & Format(ar(jj, jjj), "dd-mm-yyyy")
                Else
                    c01 = c01 & Chr(10) & ar(1, jjj) & ", vervaldatum " & Format(ar(jj, jjj), "dd-mm-yyyy")
                End If
            End If
        Next jjj
    Next jj
    MsgBox c01
    'mail procedure
    c01 = ""
Next j
End Sub

 

[HWV]

Mail erin gezet, enkel niet per leverancier

VenA

Bedankt!

(ik ben nu uit gegaan van de code van VenA die code is geschreven op mijn eerste post / bestand , vandaar dat ik daarmee verder ben gegaan)

Sub Mail_on_Date()
Dim Rng As Range, cl As Range, cll As Range
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
     
ar = Sheets("Documenten_registratie").[A11].CurrentRegion.Resize(, 17)
For j = 12 To UBound(ar)
    If InStr(1, C00, ar(j, 5)) = 0 Then C00 = C00 & "|" & ar(j, 5)
Next j

For j = 0 To UBound(Split(Mid(C00, 2), "|"))
    For jj = 12 To UBound(ar)
        For jjj = 6 To 16
            If ar(jj, 5) = Split(Mid(C00, 2), "|")(j) And ar(jj, jjj) <> "" And DateDiff("d", Date, ar(jj, jjj)) < 28 Then
                If Len(C01) = 0 Or InStr(1, C01, ar(jj, 1)) = 0 Then
                    C01 = C01 & Chr(10) & Chr(10) & ar(jj, 1) & " " & ar(jj, 2) & "," & Chr(10) & ar(1, jjj) & ", vervaldatum " & Format(ar(jj, jjj), "dd-mm-yyyy")
                Else
                    C01 = C01 & Chr(10) & ar(1, jjj) & ", vervaldatum " & Format(ar(jj, jjj), "dd-mm-yyyy")
                End If
            End If
        Next jjj
    Next jj
'MsgBox C01
    'mail procedure
    EmailSubject = "Aanvraag geldige Productspecificatie en Certificaten"

'Send Mail
        With CreateObject("Outlook.Application").CreateItem(0)
            .Subject = EmailSubject
            .To = "info@test.nl"
            .body = "Beste," & vbNewLine & vbNewLine _
    & "De volgende documenten zijn verlopen of zullen bijna verlopen : " & C01 & vbNewLine & vbNewLine & "Wij willen u dan ook vragen deze geldige documenten ons toe te sturen zodat wij deze gegevens juist hebben voor onze BRC" & vbNewLine & vbNewLine & "Met vriendelijke groet," & vbNewLine & vbNewLine & "Henk"
            .Display
        End With
    C01 = ""
Next j
        
End Sub

Code ingevoegd maar loop toch tegen het probleem verzenden per leverancier.
Ik krijg nu netjes de mail per leverancier, maar niet met de juiste e-mailadres erbij uit sheet Leverancier.
Deze staat nu ook niet in de code, verschillende dingen geprobeerd maar geen passend resultaat.

en dan nog het vullen als er een mail verzonden is
Bekijk bijlage Voorbeeld_mail_leverancier_documenten.xlsm
HWV

 

[HSV]

Andere methode.

Sub Mail_on_Date1()

Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
   
   sn = Sheets("Documenten_registratie").Cells(1).CurrentRegion
   For j = 2 To UBound(sn)
    If Cells(j, 16) = "" Then
     For x = j To UBound(sn)
       If sn(x, 5) = sn(j, 5) Then
         
        For jj = 6 To 14
         If sn(j, jj) <> "" And DateDiff("d", Date, sn(j, jj)) < 31 Then
            c00 = c00 & IIf(InStr(c00, sn(x, 2)) = 0, vbLf & sn(x, 1) & "  " & sn(x, 2) & vbLf, "") & sn(1, jj) & "  " & sn(x, jj) & vbLf
           Cells(x, 16) = "verstuurd"
          End If
        Next jj
      End If
      Next x
    
   
        
'Subject string
    EmailSubject = "Aanvraag productspecificatie cq Certificaten"
    EmailSendTo = Sheets("leverancier").Cells(Application.Match(sn(j, 5), Sheets("Leverancier").Columns(2), 0), 3)
    
'Send Mail
        With CreateObject("Outlook.Application").CreateItem(0)
            .Subject = EmailSubject
            .To = EmailSendTo
            '.Bcc =
            .body = "Beste," & vbNewLine & vbNewLine _
    & "Wij missen nog de volgende documenten : " & vbLf & c00 & vbLf & "Met vriendelijke groet," _
    & vbNewLine & vbNewLine & "Henk"

            .Display
            '.send
        End With
        c00 = ""
   End If
 Next j
End Sub

 

[snb]

Sub M_snb()
   st = Sheets("Leverancier").Cells(1).CurrentRegion.Columns(1)
   sq = Sheets("Leverancier").Cells(1).CurrentRegion.Columns(3)
   sn = Sheets("Documenten_registratie").Cells(1).CurrentRegion
   
   For j = 2 To UBound(sn)
      For jj = 6 To 14
         If sn(j, jj) <> "" And DateDiff("d", Date, sn(j, jj)) < 29 Then c00 = c00 & vbLf & sn(j, 1) & "_" & sq(Application.Match(sn(j, 4), st, 0), 1) & "_" & sn(1, jj)
      Next
   Next
   
   sn = Split(Mid(c00, 2), vbLf)
   With CreateObject("outlook.application")
      Do
       With .createitem(0)
           c00 = Split(sn(0), "_")(1)
          .To = c00
          .body = "Dit voelen wij als een gemis" & String(2, vbLf) & Replace(Join(Filter(sn, c00), vbLf), "_" & c00 & "_", vbTab)
          .send
          sn = Filter(sn, c00, 0)
        End With
      Loop Until UBound(sn) = -1
   End With
End Sub

 

[Timshel]

Heb ik er ook nog eentje:
Verstuurt één mail per leverancier.
Geeft per cel een kleurindicatie "verstuurd".

 

[VenA]

Het is niet erg handig dat als er code op maat gemaakt moet worden je jouw berichten gaat aanpassen en dan weer een ander uitgangspunt kiest. Zeer waarschijnlijk zal de code van HSV, snb en Timshel het niet doen in jouw aangepaste bestand. Alle ingrediënten voor het oplossen zijn te vinden. Dus het inpassen in jouw echte bestand laat ik maar aan jou over.

 

[HWV]

Een hoop keuze op deze manier

Bedankt voor de reactie.

Ik heb nu het bestand van HSV genomen en die werkt goed, enkel als er al verstuurd staat dan wil hij toch nog een mail verzenden met geen gegevens erin.
Eigenlijk moet er dan niks gebeuren.

De andere optie's werken ook goed en zal deze verder uitdiepen.

Ik ben het eens met VenA dat het niet handig is van mij geweest om met twee bestanden te werken ( mijn excuus hiervoor) want een ieder heeft veel inspanning hiervoor geleverd.

HWV

Bekijk bijlage Voorbeeld_mail_leverancier_documenten_1.xlsm

 

[HSV]

Die van mij is tussentijds gewijzigd.
Werkt nu prima volgens mij.

 

[HWV]

Had ik nog niet gezien!
Heb het in mijn bestand gezet en werkt goed.

de optie met het kleuren van de cellen vind een goed idee.
Ik zal dan ook proberen om dit toe te passen in het bestand van HSV maar heb al ondervonden dat dit niet makkelijk is.

Maar dit is dan voor later

Bedankt

HWV

 

[snb]

Het kleuren van cellen lijkt me geen goed idee, want niet eenvoudig uit te lezen met VBA.

 

[HWV]

SNB,

Bedankt voor de tip.

Ik wilde het gebruiken om in één oogopslag te zien welk van de documenten we hebben aangevraagd niet om te gebruiken om te werken met VBA.

Henk

 

[HWV]

Met lege cel, geen datum nu ook een mail

HSV,

Ik kom erachter dat het nog niet helemaal goed gaat.
Het bestand bevat ook nog lege regels in de mail, dus waar nog geen datum staat gevuld in het formulier daar stuurt hij wel een mail heen.

Nu pakt hij deze ook mee (zie bestand) daar heb ik een lege regel toegevoegd en dan stuurt hij ook een mail maar zonder gegevens erin.

Is dit zo aan te passen dat als er in kolom 6 -16 helemaal niks is gevuld dat hij dan geen mail stuurt.

Hij stuurt ook nog meerdere mails naar één leverancier.
Mail 1, stuurt hij 1 artikel van de leverancier
Mail 2, stuurt hij 2 artikelen van deze leverancier
mail 3, stuurt hij 3 artikelen van deze leverancier
enz
mail 1 en mail 2 zitten dus ook in mail 3 enz

De bedoeling is dat hij enkel de mail krijgt met alleen de totaal anders van deze leverancier bv 25 mails krijgen met de opbouw zoals hierboven beschreven.

Bekijk bijlage Voorbeeld_mail_leverancier_documenten.xlsb

Alvast dank voor je reactie !

HWV