• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Mail versturen op datum meerder kolommen

  • Onderwerp starter Onderwerp starter HWV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
lijkt goed te werken

HSV,

Ik heb het getest en ziet er goed uit.
Ik kan het enkel morgen pas op het originele bestand toepassen, ik laat het je nog weten

Voor als nog bedankt voor je inzet

Henk
 
Dus het originele bestand is weer anders?

Hoe ga je er mee om als een verloopdatum van een bepaald certificaat voldoet aan de voorwaarde maar 1 of meerdere bv een datum - voorwaarde +1 hebben? De rij krijgt de status verstuurd. Voor de andere certificaten zal er dus nooit mail verstuurd worden.

In mijn optiek is de dataopzet niet echt geschikt voor hetgeen je wilt. Maak er een gestructureerde tabel van waarin je gegevens bijhoudt.
 
Beste,

Mijn doel is idd om de certificaten bijbrengen houden op de manier zoals we nu hebben.
Zodra ik een nieuw certificaat heb ontvangen dan zal ik achter het artikel verstuurd weg moeten halen.

Het is idd wel nog wat werk. Maar voor nu is dit de beste oplossing, maar nogmaals ik sta open voor verbeteringen waardoor het bestand makkelijker en overzichtelijker wordt.

Al zou ik zelf niet weten hoe, maar daarom ben ik heel erg blij met de hulp die een ieder hierin bied.

Henk
 
Snap de opzet niet

Beste SNB,

Ik snap niet echt wat de veranderingen doen.
En voor mij niet eenvoudiger om het te berijpen dan.

Is het mogelijk een korte uitleg zodat ik dit kan begrijpen en er van te leren.

Ik zie niet wat de veranderingen doen in VBA die bij mij niet goed draait en een foutmelding geeft

Henk
 
Gewoon kijken en vergelijken wat er in de tabel staat.
Van voorkauwen word je niets wijzer.
De macro moet natuurlijk nog wel aangepast worden aan de gewijzigde opbouw van de tabel.
 
Geen mail, toch verstuurd neerzetten

HSV,

Ik heb het bestand geprobeerd in het originele bestand van 4600 regels.
Daar vallen mij twee dingen op:

- Het scherm loopt vast en blijft vast staan, in de tussentijd krijg ik wel de mail dus dat gaat goed
(na vier minuten heb ik het onderbroken)
- Als er geen mail verstuurd wordt omdat de rij leeg is, dan zet hij wel neer verstuurd terwijl dit niet mag gebeuren. dus geen datum in de regel dan niet neerzetten verstuurd


SNB,
Ik heb het bekeken en zie de formule en wat het doet.
Enkel wat voor voordeel heeft dit voor VBA, dat het allemaal op één sheet gebeurd !

Henk
 
Laatst bewerkt:
Enkel wat voor voordeel heeft dit voor VBA, dat het allemaal op één sheet gebeurt ?
Klik om te vergroten...

Dat wordt je duidelijk als je de VBA code aanpast.
 
Code: 
Sub Mail_on_DateHSV()

Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
   
   sn = Sheets("Documenten_registratie").Cells(1).CurrentRegion.Resize(, 18)
   For j = 2 To UBound(sn)
     For x = j To UBound(sn)
       If sn(x, 6) = sn(j, 6) And sn(x, 17) = "" Then
         sn(x, 17) = "verstuurd"
         sn(x, 18) = Date
        For jj = 7 To 16
         If sn(x, jj) <> "" And DateDiff("d", Date, sn(x, jj)) < 31 Then
            c00 = c00 & IIf(InStr(c00, sn(x, 2)) = 0, vbLf & sn(x, 1) & "  " & sn(x, 2) & vbLf, "") & sn(1, jj) & ", vervallen of vervalt op datum :  " & sn(x, jj) & vbLf
          End If
        Next jj
      End If
      Next x

 If c00 <> "" Then
'Subject string
    EmailSubject = "Aanvraag productspecificatie cq Certificaten"
[B][/B][COLOR="#FF0000"]    EmailSendTo = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 3)
    Emailtav = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 2)[/COLOR]
    
'Send Mail

        With CreateObject("Outlook.Application").createitem(0)
            .Subject = EmailSubject
            .To = EmailSendTo
            '.Bcc =
            .body = "Beste " & Emailtav & "," & vbNewLine & vbNewLine _
    & "Volgens onze administratie van onze BRC, zijn er certificaten verlopen. Hieronder ziet u een overzicht van de verlopen certificaten: " & vbLf & c00 & vbNewLine & "Wij willen u dan ook vragen deze geldige certificaten ons toe te sturen zodat wij deze gegevens juist hebben voor onze BRC" & vbNewLine & vbNewLine & "Met vriendelijke groet," & vbNewLine & vbNewLine & "BRC Team" & vbNewLine & "leveranciernaam"

            .Display
            '.send
        End With
        c00 = ""
    End If
    Cells(1).CurrentRegion.Resize(, 18) = sn
 Next j
End Sub

Ik heb de verandering aangebracht maar loop vast op dat hij moet gaan zoeken naar de mailadressen en naam (in het rood)
Met de aanpassing die ik had gedaan gaat niet goed, maar dat is meer de onwetendheid van mij want die verandering weet ik echt niet hoe ik die moet maken.

Hieronder het geen wat ik had veranderd

Code: 
    EmailSendTo = Sheets("Documenten_registratie").Cells(Application.Match(sn(j, 4), Sheets("Documenten_registratie").Columns(1), 0), 5)
    Emailtav = Sheets("Documenten_registratie").Cells(Application.Match(sn(j, 4), Sheets("Documenten_registratie").Columns(1), 0), 6)

Henk
 
Wil me niet lukken om aan te passen

Beste HSV,

Ik borduur door op uw code, maar ik loop toch vast op nog één punt.
Het punt dat hij vastliep lag aan mijn pc en mijn ongeduldigheid. Hij doet er tien minuten over maar doet zijn werk.

Wat er nu nog open blijf staan en mij echt niet wil lukken om aan te passen is het volgende:

Als de regel helemaal leeg is dus als er geen datum is gevuld zoals in mijn voorbeeld bestand regel 6 artikel 1030257. Dat er dan in kolom P bij "aangevraagd" niet komt te staan dat het document is aangevraagd, dat kan ook niet omdat er ook geen mail verstuurd is.
Dit is ook zo als er geen datum overschreden wordt en er geen mail verstuurd wordt naar een leverancier, dat er dan in kolom P bij "aangevraagd" komt te staan terwijl dat niet moet omdat er geen mail verstuurd is

Zou hier ik hier nog wat hulp in kunnen krijgen.

Alvast bedankt voor de genomen moeite!

Bekijk bijlage Voorbeeld_mail_leverancier_documenten.xlsb

Henk
 
Laatst bewerkt:
Je kan in de code toch zien wanneer en wat voor waarde sn(x,17) krijgt?
Als je dit verplaatst naar net boven Next x en even controleert of c00 leeg is of niet dan lijkt het mij toch vrij makkelijk aan te passen.
 
Test het zo maar eens weer.
Code: 
Sub Mail_on_DateHSVNieuw()


Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
   
   sn = Sheets("Documenten_registratie").Cells(1).CurrentRegion.Resize(, 17)
   For j = 2 To UBound(sn)
     For x = j To UBound(sn)
       If sn(x, 5) = sn(j, 5) And sn(x, 16) = "" Then
         
        For jj = 6 To 15
         If sn(x, jj) <> "" And DateDiff("d", Date, sn(x, jj)) < 31 Then
            sn(x, 16) = "verstuurd"
            sn(x, 17) = Date
            c00 = c00 & IIf(InStr(c00, sn(x, 2)) = 0, vbLf & sn(x, 1) & "  " & sn(x, 2) & vbLf, "") & "- " & sn(1, jj) & ", is vervallen of vervalt op datum :  " & sn(x, jj) & " , uw nummer : " & sn(x, 3) & vbLf
          End If
        Next jj
      End If
      Next x


 If c00 <> "" Then
         
'Subject string
    EmailSubject = "Aanvraag productspecificatie cq Certificaten"
    EmailSendTo = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 3)
    Emailtav = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 2)
    
'Send Mail


        With CreateObject("Outlook.Application").createitem(0)
            .Subject = EmailSubject
            .To = EmailSendTo
            '.Bcc =
            .body = "Beste " & Emailtav & "," & vbNewLine & vbNewLine _
    & "Volgens onze administratie zijn onderstaande BRC certificaten verlopen." & vbLf & c00 & vbNewLine & "Wij willen u dan ook vragen om ons binnen 14 dagen nieuwe geldige certificaten toe te sturen." & vbNewLine & "Bij voorbaat dank voor uw medewerking." & vbNewLine & vbNewLine & "Met vriendelijke groet," & vbNewLine & vbNewLine & "BRC Team" & vbNewLine & "ZNP Verpakkingen BV"


            .Display
            '.send
        End With
        c00 = ""
    End If
    Cells(1).CurrentRegion.Resize(, 17) = sn
 Next j
 
niet echt

Ven A,

Na geprobeerd te hebben te snappen wat ik eigenlijk al dagen doet, gaat het niet lukken.
Dan gaat de VBA mij toch te ver, zo giga ben ik daar zeker niet in.

Met f8 laat ik hem lopen en zie wanneer sn(x,17) waarde krijgt:

Dat krijgt hij onderaan toegewezen
Code: 
    Cells(1).CurrentRegion.Resize(, 17) = sn

Tenminste dat denk ik te zien

Dus als ik dit plaats boven de next x gebeurd er weinig

Moeilijk te begrijpen dit VBA

Dus ben echt bang dat ik meer hulp nodig heb

Henk
 
Zie het berichtje van HSV waarin de code een paar regels boven de Next x staat wat een IF THEN scheelt.
 
gelukt

Ik zie de verandering die je nu bedoel VenA, maar het snappen is nog moeilijker.

HSV bedankt voor de hulp.
Het verstandigste is te doen met 4700 regels eerst te sorteren op leverancier, ik zie dat hij er langer over doet, maar ben zo blij dat dit nu werkend is.
Nu ga ik de puntjes op de i zetten en het bestand compleet maken met alle gegevens dan kan ik pas echt de test doen hoe lang hij er over doet.

Voor nu erg bedankt voor de hulp, ik had hier nooit zelf uit gekomen.:thumb:

Henk
 
Zet in het begin van de code om het te versnellen.
Code: 
application.screenupdating = false
 
stuk sneller

Dat gaat een stuk sneller met deze toevoeging.
Ik ben benieuwd wat het doet in het originele bestand.

Dank voor de hulp

Henk
 
Nederlands en engelse taal in code als tekst

Beste,

Om de code verder uit te breiden wil ik erin bouwen dat het in het Engels en in het Nederlands neergezet gaat worden.

Bekijk bijlage Documenten en Certificaten overzicht NL-E.xlsb

In de bijlage de aangepaste bestand maar krijg het niet geheel werkend.
Ik krijg de Talen goed enkel bij leverancier 5 geef hij bij mij de talen door elkaar.

Ik heb de sheet Leverancier kolom D aangegeven welke taal het moet worden en daar laat ik dan kijken welke taal er in gezet moet worden met de IF en ELSE.

Misschien is er een betere manier maar mij niet bekend.

Wat doe ik verkeerd dat hij toch de talen door elkaar pakt

Code: 
Sub Mail_on_DateHSVNieuw2()

Application.ScreenUpdating = False

Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
   
   sn = Sheets("Documenten_registratie").Cells(1).CurrentRegion.Resize(, 17)
   For j = 2 To UBound(sn)
     For x = j To UBound(sn)
       If sn(x, 5) = sn(j, 5) And sn(x, 16) = "" Then
         
        For jj = 6 To 15
         If sn(x, jj) <> "" And DateDiff("d", Date, sn(x, jj)) < 31 Then
            sn(x, 16) = "verstuurd"
            sn(x, 17) = Date
[COLOR="#FF0000"]If Emailtaal = "NL" Then
            c00 = c00 & IIf(InStr(c00, sn(x, 2)) = 0, vbLf & sn(x, 1) & "  " & sn(x, 2) & vbLf, "") & "- " & sn(1, jj) & ", is vervallen of vervalt op datum :  " & sn(x, jj) & " , uw nummer : " & sn(x, 3) & vbLf
Else
            c00 = c00 & IIf(InStr(c00, sn(x, 2)) = 0, vbLf & sn(x, 1) & "  " & sn(x, 2) & vbLf, "") & "- " & sn(1, jj) & ", has expired or will expire on date :  " & sn(x, jj) & " , your number : " & sn(x, 3) & vbLf
End If[/COLOR]
          End If
        Next jj
      End If
      Next x


 If c00 <> "" Then
         
'Subject string
    EmailSubject = "Aanvraag productspecificatie cq Certificaten"
    EmailSendTo = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 3)
    Emailtav = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 2)
   [COLOR="#FF0000"] Emailtaal = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 4)[/COLOR]
    
'Send Mail


        With CreateObject("Outlook.Application").createitem(0)
            .Subject = EmailSubject
            .To = EmailSendTo
[COLOR="#FF0000"]If Emailtaal = "NL" Then
            .body = "Beste " & Emailtav & "," & vbNewLine & vbNewLine _
    & "Volgens onze administratie zijn onderstaande BRC certificaten verlopen." & vbLf & c00 & vbNewLine & "Wij willen u dan ook vragen om ons binnen 14 dagen nieuwe geldige certificaten toe te sturen." & vbNewLine & "Bij voorbaat dank voor uw medewerking." & vbNewLine & vbNewLine & "Met vriendelijke groet," & vbNewLine & vbNewLine & "BRC Team" & vbNewLine & "Bedrijfsnaam"
Else
            .body = "Dear " & Emailtav & "," & vbNewLine & vbNewLine _
    & "According to our administration are the below BRC certificates expired." & vbLf & c00 & vbNewLine & "We want to ask you to send us new valid certificates within 14 days." & vbNewLine & "Thanks in advance for your cooperation." & vbNewLine & vbNewLine & "Sincerely," & vbNewLine & vbNewLine & "BRC Team" & vbNewLine & "Bedrijfsnaam"
           
End If[/COLOR]
            .Display
        End With
        c00 = ""
    End If
    Cells(1).CurrentRegion.Resize(, 17) = sn
 Next j
 End Sub
 
Dan moet je eerst testen op welke taal het is.
De laatste rode coderegel heb ik in het blauw gezet.

HWV zei:
Code: 
Sub Mail_on_DateHSVNieuw2()

Application.ScreenUpdating = False

Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
   
   sn = Sheets("Documenten_registratie").Cells(1).CurrentRegion.Resize(, 17)
   For j = 2 To UBound(sn)
     For x = j To UBound(sn)
       If sn(x, 5) = sn(j, 5) And sn(x, 16) = "" Then
         
        For jj = 6 To 15
         If sn(x, jj) <> "" And DateDiff("d", Date, sn(x, jj)) < 31 Then
            sn(x, 16) = "verstuurd"
            sn(x, 17) = Date
[COLOR=#3366ff] Emailtaal = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 4)[/COLOR]
[COLOR=#FF0000]If Emailtaal = "NL" Then
            c00 = c00 & IIf(InStr(c00, sn(x, 2)) = 0, vbLf & sn(x, 1) & "  " & sn(x, 2) & vbLf, "") & "- " & sn(1, jj) & ", is vervallen of vervalt op datum :  " & sn(x, jj) & " , uw nummer : " & sn(x, 3) & vbLf
Else
            c00 = c00 & IIf(InStr(c00, sn(x, 2)) = 0, vbLf & sn(x, 1) & "  " & sn(x, 2) & vbLf, "") & "- " & sn(1, jj) & ", has expired or will expire on date :  " & sn(x, jj) & " , your number : " & sn(x, 3) & vbLf
End If[/COLOR]
          End If
        Next jj
      End If
      Next x


 If c00 <> "" Then
         
'Subject string
    EmailSubject = "Aanvraag productspecificatie cq Certificaten"
    EmailSendTo = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 3)
    Emailtav = Sheets("leverancier").Cells(Application.Match(sn(j, 4), Sheets("Leverancier").Columns(1), 0), 2)
   
    
'Send Mail


        With CreateObject("Outlook.Application").createitem(0)
            .Subject = EmailSubject
            .To = EmailSendTo
[COLOR=#FF0000]If Emailtaal = "NL" Then
            .body = "Beste " & Emailtav & "," & vbNewLine & vbNewLine _
    & "Volgens onze administratie zijn onderstaande BRC certificaten verlopen." & vbLf & c00 & vbNewLine & "Wij willen u dan ook vragen om ons binnen 14 dagen nieuwe geldige certificaten toe te sturen." & vbNewLine & "Bij voorbaat dank voor uw medewerking." & vbNewLine & vbNewLine & "Met vriendelijke groet," & vbNewLine & vbNewLine & "BRC Team" & vbNewLine & "Bedrijfsnaam"
Else
            .body = "Dear " & Emailtav & "," & vbNewLine & vbNewLine _
    & "According to our administration are the below BRC certificates expired." & vbLf & c00 & vbNewLine & "We want to ask you to send us new valid certificates within 14 days." & vbNewLine & "Thanks in advance for your cooperation." & vbNewLine & vbNewLine & "Sincerely," & vbNewLine & vbNewLine & "BRC Team" & vbNewLine & "Bedrijfsnaam"
           
End If[/COLOR]
            .Display
        End With
        c00 = ""
    End If
    Cells(1).CurrentRegion.Resize(, 17) = sn
 Next j
 End Sub
Klik om te vergroten...
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan