• 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 opstellen vanuit excel naar outlook, et variable gegevens

  • Onderwerp starter Onderwerp starter HWV
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.213
Beste,

Ik ben naar de mogelijkheden aan het kijken om vanuit excel emails sturen als die voldoen aan bepaalde voorwaarde en dan naar dat adres te sturen

In de bijlage het bestand met een voorbeeld hoe ik de mail opgebouwd zou willen zien.

Wij hebben per week een lijst met nieuwe artikelen die zijn aangemaakt in ons systeem.
Nu wil ik de leverancier een mail sturen dat we een nieuwe (of meerdere artikelen hebben aangemaakt) en dat ik daar de specificaties van wil hebben.
In het tabblad mailadres staan de leranciernr., naam, mailadres en contactpersoon. Vanuit de scheet artikels moet worden gekeken welk leverancier mailadres en contactpersoon er gebruikt moet worden.
Dan alle artikelen van de zelfde leverancier die komen dan in 1 mail te staan op gebouwd uit verschillende kolommen :
[artikelnummer] + [kolom B,C,D] + [kolom P]

Bekijk bijlage NIEUWE-ARTIKELS.xlsx

Groet HWV
 
Maak van te voren een nieuw tabblad aan genaamd "Blad1".
Code: 
Sub hsv()
Dim sn, sp, j As Long, i As Long, ii As Long, d As Object, out As Object, c As Range, c00 As String, c01 As String
With Sheets("nieuwe-artikels").Cells(1).CurrentRegion
 sn = .Value
 Set d = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
   d.Item(sn(i, 6)) = ""
   Next i
 For ii = 0 To d.Count - 1
 Sheets("blad1").Cells(1).CurrentRegion.ClearContents
    .AutoFilter 6, d.Keys()(ii)
    c01 = .Parent.Range(Split(.Parent.AutoFilter.Range.Offset(1).SpecialCells(12).Address, ":")(0)).Offset(, 14).Value
Union(.Columns(1).resize(,4), .Columns(16)).Copy Sheets("blad1").Cells(1)
sp = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(sp)
    c00 = c00 & Join(Application.Index(sp, j, 0)) & vbLf
  Next j
    Set out = CreateObject("Outlook.Application").CreateItem(0)
    Set c = Sheets("mailadres").Columns(2).Find(d.Keys()(ii), , , xlWhole)
        out.To = c.Offset(, 1).Value
        out.Subject = "Nieuw aangekochte artikels"
        out.Body = "Geachte " & c.Offset(, 2).Value & "," & vbNewLine & vbNewLine & _
            "hierbij blablabla van " & d.Keys()(ii) & " opgenomen blabla" & vbNewLine & vbNewLine & _
            c00 & vbNewLine & vbNewLine & _
            "Alvast bedankt" & vbNewLine & vbNewLine & _
            "Met vriendelijke groet," & vbNewLine & c01
        out.display  'out.send
     .AutoFilter
    c00 = ""
   Next ii
 End With
End Sub
 
Laatst bewerkt:
Precies wat ik zocht

HSV,

Werkt weer fantastisch, en is wat ik bedoelde.
Ik ga het verder uitwerken.

Bedankt voor jou hulp en jou snelle reactie.

HWV
 
Aanvulling op code

Beste HSV,

Het werkt perfect, enkel wil ik er een verandering in maken zodat ik per land kan kijken welke taal ik moet inzetten.
Tevens staan er in de (sheet mailadres) meerdere mail adressen en meerdere namen die aan een departement hangen.

Nu wil ik dat hij kijk welk land is het, dan kan ik bepalen of het in het Engels moet of in het Nederlands.(kolom E) in Sheet mailadres
Dan moet hij kijken in kolom G welke naamcode er staat, is deze gelijk aan BRC dan dit mail adres pakken en anders een "info@voorbeeld.nl"
Ik was al bezig met zoiets er tussen aan het bouwen maar dat werkt niet

Code: 
If c.Offset(, 2).Value = "BRC" Then
    out.To = c.Offset(, 9).Value 'was 1
Else
    out.To = "info@voorbeeld.nl"
End If

Daarom vraag ik u om hulp om dit toch voor elkaar te krijgen

Alvast dank

HWV

Bekijk bijlage NIEUWE-ARTIKELS orgineel mailen.xlsm
 
Hier alvast een begin.
Code: 
Sub hsv()
Sheets.Add.Name = "Blad1"
Dim sn, sp, j As Long, i As Long, ii As Long, d As Object, out As Object, c As Range, c00 As String, c01 As String
With Sheets("nieuwe-artikels").Cells(1).CurrentRegion
 sn = .Value
 Set d = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
   d.Item(sn(i, 6)) = ""
   Next i
 For ii = 0 To d.Count - 1
    .AutoFilter 6, d.Keys()(ii)
     c01 = .Parent.Range(Split(.Parent.AutoFilter.Range.Offset(1).SpecialCells(12).Address, ":")(0)).Offset(, 14).Value
    .Copy Sheets("blad1").Cells(1)
sp = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(sp)
    c00 = c00 & Join(Application.Index(sp, j, Array(1, 2, 3, 4, 16))) & vbLf
  Next j
  Sheets("blad1").Cells(1).CurrentRegion.ClearContents
    Set out = CreateObject("Outlook.Application").CreateItem(0)
    Set c = Sheets("mailadres").Columns(2).Find(d.Keys()(ii), , , xlWhole)
        out.To = IIf(c.Offset(, 5).Value = "BRC", c.Offset(, 2).Value, "info@voorbeeld.nl")
        out.Subject = "Nieuw aangekochte artikel(en) bij " & d.Keys()(ii)
        out.Body = "Geachte " & c.Offset(, 2).Value & "," & vbNewLine & vbNewLine & _
            "Afgelopen week hebben wij een artikel of diverse artikelen van " & d.Keys()(ii) & " opgenomen in het assortiment van ZNP Verpakkingen BV." & vbNewLine & _
"Ik wil u dan ook willen verzoeken de volgende documenten mij toe te sturen die wij nodig hebben voor onze BRC." & vbNewLine & vbNewLine & _
"- Product Data Sheet" & vbNewLine & _
"- Declaration of Compliance" & vbNewLine & _
"- Migratietesten" & vbNewLine & _
"- Heeft u pas één of meerder nieuwe certificaaten behaald, wil u deze dan gelijk meesturen." & vbNewLine & vbNewLine & _
"Hieronder vind u een overzicht van de artikelen waar wij de documenten voor nodig hebben:" & vbNewLine & vbNewLine & _
            c00 & vbNewLine & _
            "Alvast bedankt voor je medewerking." & vbNewLine & vbNewLine & _
            "Met vriendelijke groet," & vbNewLine & c01 & vbNewLine & vbNewLine & _
            "ZNP Verpakkingen BV" & vbNewLine & vbNewLine & _
            "***Deze mail is automatisch opgesteld, heeft u deze gegevens ons al toegezonden dan kunt u deze email vergeten.***" & vbNewLine & vbNewLine & _
        out.display  'out.send
     .AutoFilter
    c00 = ""
   Next ii
 End With
 Application.DisplayAlerts = False
 Worksheets("Blad1").Delete
 Application.DisplayAlerts = True
End Sub
 
Werkt weer geweldig

HSV werkt geweldig, een kleine aanpassing moeten doen voor de juiste mailadres

Code: 
        out.To = IIf(c.Offset(, 5).Value = "BRC", c.Offset(, 1).Value, "info@voorbeeld.nl")

De 2 moest 1 zijn, pakt geweldig enkel en alleen de BRC mailadres.
Echt weer een grote stap gemaakt.

Ik heb gekeken of ik de zelfde manier kan gebruiken om een taal te kiezen maar dat is iets te hoog gegrepen voor mij.
Dus ik hou me zeker aanbevolen.

Alvast erg bedankt

Henk
 
Een optie voor de taal.
Code: 
select case c.offset(,3)
    case "NL"
       out.Body ="nederlands"
    case "DE"
       out.body = "duits"
    case "S"
       out.body = "sweeds"
    case "IT"
       out.body = "italiaans"
end select
 
werkt goed, maar toch een foutmelding

HSV,

Ook dit heb ik nu in het originele bestand werkend gekregen, werkt echt top en ben er echt blij mee:d

Ik ben het geheel aan het doortesten, en dan kom ik eigenlijk nog een ding tegen.
Als er een leverancier nog niet in de lijst staat, loopt hij daar op vast omdat die niet voorkom in de maillijst
Is het mogelijk om in dat geval er ook een standaard mailadres voor te pakken bv hwv@helpmij.nl zodat ik er dan een mail over krijg en dat ik dan weet dat we de gegevens moeten vullen in ons systeem.

Alvast weer dank voor uw bericht:thumb:

Henk
 
Borduur eens verder op de laatste regel Henk.

Code: 
Set c = Sheets("mailadres").Columns(2).Find(d.Keys()(ii), , , xlWhole)
if not c is nothing then
 
niet het resultaat

Ik kom tot het volgende wat niet werkt, if else snap ik op zich wel. enkel if not c is nothing then heb ik nog nooit mee gewerkt

Code: 
Set c = Sheets("mailadres").Columns(2).Find(d.Keys()(ii), , , xlWhole)
if not c is nothing then
out.To ="info@voorbeeld.nl"
else
out.To = IIf(c.Offset(, 5).Value = "BRC", c.Offset(, 2).Value, "info@voorbeeld.nl")
end if

Henk
 
nog een poging maar helaas

Code: 
    Set c = Sheets("mailadres").Columns(1).Find(d.Keys()(ii), , , xlWhole)
    If Not c Is Nothing Then
    Do
    c.Value = "info@voorbeeld.nl"
        Set c = .FindNext(c)
    Loop While Not c Is Nothing
       End If

Beetje rond lopen zoeken op het web, over If Not c Is Nothing Then ik vond deze maar helaas niet wat werkt

Henk
 
Zoiets zou het moeten worden, anders loopt de code weer vast op 'out.body' (c.offset(,2)).

Code: 
Set c = Sheets("mailadres").Columns(2).Find(d.Keys()(ii), , , xlWhole)
if not c is nothing then
  out.to = 
  out.subject =
  out.body
  out.display
else
  out.to = "eigen mailadres"
  out.subject = d.keys()(ii) &  " is niet aanwezig of volledig"
  out.send
end if

.autofilter
c00 = ""
next ii
 
Hij neem geen body mee in de mail, enkel standaard mailadres

Harry,

Bedankt voor je reactie.
Ik heb de code verwerkt, en naar mij weten zoals jij heb aangegeven maar het gaat niet goed.
De code loopt wel door enkel ik heb geen tekst in mijn mail, en hij gebruikt enkel maar de standaard mailadres info@voorbeeld.nl
Hieronder een deel van de code, zou jij kunnen kijken wat ik niet goed heb gedaan. Want volgens mij heb ik alles goed gezet

Code: 
   Sheets("blad1").Cells(1).CurrentRegion.ClearContents
    Set out = CreateObject("Outlook.Application").CreateItem(0)
    Set c = Sheets("mailadres").Columns(2).Find(d.keys()(ii), , , xlWhole)

If Not c Is Nothing Then

    out.to = IIf(c.Offset(, 6).Value = "BRC", c.Offset(, 2).Value, "info@voorbeeld.nl")
    out.Subject = "Nieuw aangekochte artikel(en) bij " & d.keys()(ii)
    
Select Case c.Offset(, 4)
    Case "NL"
    out.body = "Geachte " & c.Offset(, 3).Value & "," & vbNewLine & vbNewLine & _
                "Afgelopen week hebben wij een artikel of diverse artikelen van " & d.keys()(ii) & " opgenomen in het assortiment van XXXXXXXXXXX." & vbNewLine & _
                "Ik wil u dan ook willen verzoeken de volgende documenten mij toe te sturen die wij nodig hebben voor onze BRC." & vbNewLine & vbNewLine & _
                "- Product Data Sheet" & vbNewLine & _
                "- Declaration of Compliance" & vbNewLine & _
                "- Migratietesten" & vbNewLine & _
                "- Heeft u pas één of meerder nieuwe certificaaten behaald, wil u deze dan gelijk meesturen." & vbNewLine & vbNewLine & _
                "Hieronder vind u een overzicht van de artikelen waar wij de documenten voor nodig hebben:" & vbNewLine & vbNewLine & _
c00 & vbNewLine & _
                "Alvast bedankt voor je medewerking." & vbNewLine & vbNewLine & _
                "Met vriendelijke groet," & vbNewLine & c01 & vbNewLine & vbNewLine & _
                "XXXXXXXXXXXXX" & vbNewLine & vbNewLine & _
                "***Deze mail is automatisch opgesteld, heeft u deze gegevens ons al toegezonden dan kunt u deze email vergeten.***" & vbNewLine & vbNewLine & _
    out.display  'out.send
    Case "E"
    out.body = "ENEGELSE TESKSTGeachte " & c.Offset(, 3).Value & "," & vbNewLine & vbNewLine & _
                "Afgelopen week hebben wij een artikel of diverse artikelen van " & d.keys()(ii) & " opgenomen in het assortiment van XXXXXXXXXXX." & vbNewLine & _
                "Ik wil u dan ook willen verzoeken de volgende documenten mij toe te sturen die wij nodig hebben voor onze BRC." & vbNewLine & vbNewLine & _
                "- Product Data Sheet" & vbNewLine & _
                "- Declaration of Compliance" & vbNewLine & _
                "- Migratietesten" & vbNewLine & _
                "- Heeft u pas één of meerder nieuwe certificaaten behaald, wil u deze dan gelijk meesturen." & vbNewLine & vbNewLine & _
                "Hieronder vind u een overzicht van de artikelen waar wij de documenten voor nodig hebben:" & vbNewLine & vbNewLine & _
c00 & vbNewLine & _
                "Alvast bedankt voor je medewerking." & vbNewLine & vbNewLine & _
                "Met vriendelijke groet," & vbNewLine & c01 & vbNewLine & vbNewLine & _
                "XXXXXXXXXXXXX" & vbNewLine & vbNewLine & _
                "***Deze mail is automatisch opgesteld, heeft u deze gegevens ons al toegezonden dan kunt u deze email vergeten.***" & vbNewLine & vbNewLine & _
    out.display  'out.send
End Select

Else
  out.to = "info@voorbeeld.nl"
  out.Subject = d.keys()(ii) & " is niet aanwezig of volledig"
   out.display  'out.send
End If

.AutoFilter
c00 = ""
Next ii
 End With

Alweer dank voor de aangeboden hulp.

Henk
 
Volgens mij krijg je een mail met subject: "Leverancier? is niet aanwezig of volledig"
 
Idd maar ook als er wel een leverantie van bestaat in de mailinglijst
 
Komt waarschijnlijk door je cases, die niet aanwezig zijn.
Jij hebt twee cases, nl. NL en ENG. (alhoewel de tekst hier in het Nederlands staat voor de Engelsen).
Ik heb er een case 'else' aan toegevoegd, als je die case niet hebt dat de body automatisch in het Nederlands is.

Code: 
Sub hsv()
Sheets.Add.Name = "Blad1"
Dim sn, sp, j As Long, i As Long, ii As Long, d As Object, out As Object, c As Range, c00 As String, c01 As String
With Sheets("nieuwe-artikels").Cells(1).CurrentRegion
 sn = .Value
 Set d = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
   d.Item(sn(i, 6)) = ""
   Next i
 For ii = 0 To d.Count - 1
    .AutoFilter 6, d.keys()(ii)
     c01 = .Parent.Range(Split(.Parent.AutoFilter.Range.Offset(1).SpecialCells(12).Address, ":")(0)).Offset(, 14).Value
    .Copy Sheets("blad1").Cells(1)
sp = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(sp)
    c00 = c00 & Join(Application.Index(sp, j, Array(1, 2, 3, 4, 16))) & vbLf
  Next j
  Sheets("blad1").Cells(1).CurrentRegion.ClearContents
    Set out = CreateObject("Outlook.Application").CreateItem(0)
    Set c = Sheets("mailadres").Columns(2).Find(d.keys()(ii), , , xlWhole)
     If Not c Is Nothing Then
        out.to = IIf(c.Offset(, 5).Value = "BRC", c.Offset(, 2).Value, "info@voorbeeld.nl")
        out.Subject = "Nieuw aangekochte artikel(en) bij " & d.keys()(ii)
        Select Case c.Offset(, 3)
    Case "DE"
     out.body = "Duitse versie"
    Case "E"
    out.body = "ENEGELSE TESKSTGeachte " & c.Offset(, 3).Value & "," & vbNewLine & vbNewLine & _
                "Afgelopen week hebben wij een artikel of diverse artikelen van " & d.keys()(ii) & " opgenomen in het assortiment van XXXXXXXXXXX." & vbNewLine & _
                "Ik wil u dan ook willen verzoeken de volgende documenten mij toe te sturen die wij nodig hebben voor onze BRC." & vbNewLine & vbNewLine & _
                "- Product Data Sheet" & vbNewLine & _
                "- Declaration of Compliance" & vbNewLine & _
                "- Migratietesten" & vbNewLine & _
                "- Heeft u pas één of meerder nieuwe certificaaten behaald, wil u deze dan gelijk meesturen." & vbNewLine & vbNewLine & _
                "Hieronder vind u een overzicht van de artikelen waar wij de documenten voor nodig hebben:" & vbNewLine & vbNewLine & _
c00 & vbNewLine & _
                "Alvast bedankt voor je medewerking." & vbNewLine & vbNewLine & _
                "Met vriendelijke groet," & vbNewLine & c01 & vbNewLine & vbNewLine & _
                "XXXXXXXXXXXXX" & vbNewLine & vbNewLine & _
                "***Deze mail is automatisch opgesteld, heeft u deze gegevens ons al toegezonden dan kunt u deze email vergeten.***" & vbNewLine & vbNewLine
Case Else
   out.body = "Geachte " & c.Offset(, 3).Value & "," & vbNewLine & vbNewLine & _
                "Afgelopen week hebben wij een artikel of diverse artikelen van " & d.keys()(ii) & " opgenomen in het assortiment van XXXXXXXXXXX." & vbNewLine & _
                "Ik wil u dan ook willen verzoeken de volgende documenten mij toe te sturen die wij nodig hebben voor onze BRC." & vbNewLine & vbNewLine & _
                "- Product Data Sheet" & vbNewLine & _
                "- Declaration of Compliance" & vbNewLine & _
                "- Migratietesten" & vbNewLine & _
                "- Heeft u pas één of meerder nieuwe certificaaten behaald, wil u deze dan gelijk meesturen." & vbNewLine & vbNewLine & _
                "Hieronder vind u een overzicht van de artikelen waar wij de documenten voor nodig hebben:" & vbNewLine & vbNewLine & _
c00 & vbNewLine & _
                "Alvast bedankt voor je medewerking." & vbNewLine & vbNewLine & _
                "Met vriendelijke groet," & vbNewLine & c01 & vbNewLine & vbNewLine & _
                "XXXXXXXXXXXXX" & vbNewLine & vbNewLine & _
                "***Deze mail is automatisch opgesteld, heeft u deze gegevens ons al toegezonden dan kunt u deze email vergeten.***" & vbNewLine & vbNewLine
End Select
        out.display  'out.send
        Else
        out.to = "blabla"
        out.Subject = d.keys()(ii) & " is niet aanwezig of volledig"
        out.send
        End If
     .AutoFilter
    c00 = ""
   Next ii
 End With
 Application.DisplayAlerts = False
 Worksheets("Blad1").Delete
 Application.DisplayAlerts = True
End Sub
 
Laatst bewerkt:
Geweldig

Beste HSV,

Werkt weer perfect, ga het morgen toepassen po het originele bestand, verwacht geen problemen.
Nogmaals dank voor je hulp hierin,

Groet Henk:thumb:
 
fout bij filter naar mail toe

Beste HSV,

Ik ben het geheel aan het doortesten en kom er achter dat de filter wel goed werkt maar dat er artikelen bij de verkeerde leverancier terecht komen.
Gekeken wat er mis kan gaan maar ik kan het niet ontdekken, enkel dat er misschien artikelen in het geheugen blijven zitten .
Ik zou u willen vragen of u misschien ziet wat er mis gaat.

Code: 
Sub hsv()
Sheets.Add.Name = "Blad1"
Dim sn, sp, j As Long, i As Long, ii As Long, d As Object, out As Object, c As Range, c00 As String, c01 As String
With Sheets("nieuwe-artikels").Cells(1).CurrentRegion
 sn = .Value
 Set d = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
   d.Item(sn(i, 6)) = ""
   Next i
 For ii = 0 To d.Count - 1
    .AutoFilter 6, d.keys()(ii)
     c01 = .Parent.Range(Split(.Parent.AutoFilter.Range.Offset(1).SpecialCells(12).Address, ":")(0)).Offset(, 14).Value
    .Copy Sheets("blad1").Cells(1)
sp = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(sp)
    If Join(Application.Index(sp, j, Array(16))) = "" Then
    c00 = c00 & Join(Application.Index(sp, j, Array(1))) & vbLf & Join(Application.Index(sp, j, Array(2, 3, 4))) & vbLf & "" & vbLf
  Else
    c00 = c00 & Join(Application.Index(sp, j, Array(1))) & " - uw nummer : " & Join(Application.Index(sp, j, Array(16))) & vbLf & Join(Application.Index(sp, j, Array(2, 3, 4))) & vbLf & "" & vbLf
    c000 = c000 & Join(Application.Index(sp, j, Array(1))) & " - your number : " & Join(Application.Index(sp, j, Array(16))) & vbLf & Join(Application.Index(sp, j, Array(2, 3, 4))) & vbLf & "" & vbLf

End If
  Next j
  Sheets("blad1").Cells(1).CurrentRegion.ClearContents
    Set out = CreateObject("Outlook.Application").CreateItem(0)
    Set c = Sheets("mailadres").Columns(2).Find(d.keys()(ii), , , xlWhole)
     If Not c Is Nothing Then
        out.to = IIf(c.Offset(, 5).Value = "BRC", c.Offset(, 1).Value, "info@voorbeeld.nl")
        out.Subject = "Nieuw aangekochte artikel(en) bij " & d.keys()(ii)
        Select Case c.Offset(, 3)
    
    Case "BE"
    out.body = "Geachte " & c.Offset(, 2).Value & " " & c.Offset(, 6).Value & "," & vbNewLine & vbNewLine & _
                "Afgelopen week hebben wij één of meerdere artikelen opgenomen van " & d.keys()(ii) & " opgenomen in het assortiment van XXXXXXXXXXXXXX." & vbNewLine & _
                "Ik zou u dan ook willen verzoeken om de volgende documenten naar mij toe te sturen t.b.v onze BRC registratie." & vbNewLine & vbNewLine & _
                "- Product Data Sheet" & vbNewLine & _
                "- Declaration of Compliance" & vbNewLine & _
                "- Migratietesten" & vbNewLine & _
                "- Heeft u pas één of meerder nieuwe certificaaten behaald, wil u deze dan gelijk meesturen." & vbNewLine & vbNewLine & _
                "Hieronder vind u een overzicht van de artikelen waar wij de documenten voor nodig hebben:" & vbNewLine & vbNewLine & _
c00 & _
                "Alvast bedankt voor je medewerking." & vbNewLine & vbNewLine & _
                "Met vriendelijke groet," & vbNewLine & c01 & vbNewLine & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & vbNewLine & _
                "***Deze mail is automatisch opgesteld, heeft u deze gegevens ons al toegezonden dan kunt u deze email vergeten***" & vbNewLine & vbNewLine

    Case "NL"
    out.body = "Geachte " & c.Offset(, 2).Value & " " & c.Offset(, 6).Value & "," & vbNewLine & vbNewLine & _
                "Afgelopen week hebben wij één of meerdere artikelen opgenomen van " & d.keys()(ii) & " opgenomen in het assortiment van XXXXXXXXXXXXXX." & vbNewLine & _
                "Ik zou u dan ook willen verzoeken om de volgende documenten naar mij toe te sturen t.b.v onze BRC registratie." & vbNewLine & vbNewLine & _
                "- Product Data Sheet" & vbNewLine & _
                "- Declaration of Compliance" & vbNewLine & _
                "- Migratietesten" & vbNewLine & _
                "- Heeft u pas één of meerder nieuwe certificaaten behaald, wil u deze dan gelijk meesturen." & vbNewLine & vbNewLine & _
                "Hieronder vind u een overzicht van de artikelen waar wij de documenten voor nodig hebben:" & vbNewLine & vbNewLine & _
c00 & _
                "Alvast bedankt voor je medewerking." & vbNewLine & vbNewLine & _
                "Met vriendelijke groet," & vbNewLine & c01 & vbNewLine & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & vbNewLine & _
                "***Deze mail is automatisch opgesteld, heeft u deze gegevens ons al toegezonden dan kunt u deze email vergeten***" & vbNewLine & vbNewLine
Case Else
    out.body = "Dear " & c.Offset(, 2).Value & " " & c.Offset(, 6).Value & "," & vbNewLine & vbNewLine & _
                "Last week we included one or more articles from " & d.keys()(ii) & " Included in the assortment of XXXXXXXXXXXXXX." & vbNewLine & _
                "I would therefore like to request that you send me the following documents as per our BRC registration." & vbNewLine & vbNewLine & _
                "- Product Data Sheet" & vbNewLine & _
                "- Declaration of Compliance" & vbNewLine & _
                "- Migration tests" & vbNewLine & _
                "- If you have only obtained one or more new certificates, please send them one more." & vbNewLine & vbNewLine & _
                "Below you will find an overview of the items we need the documents for:" & vbNewLine & vbNewLine & _
c000 & _
                "Thanks for your cooperation." & vbNewLine & vbNewLine & _
                "Kind regards," & vbNewLine & c01 & vbNewLine & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & _
                "XXXXXXXXXXXXXX" & vbNewLine & vbNewLine & _
                "***This mail has been automatically set up, have you already sent this information to us, please forget this email***" & vbNewLine & vbNewLine
End Select
        out.display  'out.send
        Else
        out.to = "INFO@VOORBEELD.NL"
        out.Subject = d.keys()(ii) & " is niet aanwezig of volledig"
        out.display  'out.send
        End If
     .AutoFilter
    c00 = ""
   Next ii
 End With
 Application.DisplayAlerts = False
 Worksheets("Blad1").Delete
 Application.DisplayAlerts = True
End Sub


Bekijk bijlage NIEUWE-ARTIKELS orgineel mailen_1.xlsm


Alvast weer erg bedankt voor de aangeboden hulp :thumb:

Henk
 
Henk,

Code: 
c00 = ""
[COLOR=#ff0000]    
c000 = ""[/COLOR]
 
De oplossing

Beste HSV,

idd is dit het, niet over nagedacht ik had die toevoeging gedaan en niet meer leeg gemaakt.
Top, en nogmaals dank voor de aangeboden hulp

Henk
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan