Excel VBA bestanden mailen via een werkblad

[alexander321]

Wat ik graag zou willen, is diverse bestanden mailen die klaar staan in een werkmap.
Ik wil dit graag doen via een werkblad waarop alle gegevens staan.
Nu lukt het me wel om 1 vaste rij te mailen, zie onderstaand.
Wat ik graag zou willen is dat na het versturen automatisch de volgende rij wordt gepakt.
Doordat er heel at variabelen inzetten, zit ik hier al even op te puzzelen.
Wie weet raad?

Alvast dank!

Gr Alexander.

Ik gebruik deze code:

Sub Email_Afname()
' Open benodigde excel bestand
    Workbooks.Open FileName:="G:\Takenlijst\Takenlijst.xlsx"
' Mail het bestand naar klant
    Application.DisplayAlerts = False
' Haal variabelen op
    KlantNr = Range("B3").Value
    EmailSubject = Range("G3").Value
    EmailAan = Range("H3").Value
    EmailContact = Range("I3").Value
    EmailCC = Range("J3").Value
    EmailBCC = Range("K3").Value
    EmailBestand = "K:\Afdelingen\Marketing\Afnameoverzichten\" & Range("L3").Value
With CreateObject("Outlook.Application").CreateItem(olMailItem)
    .To = EmailAan
    .CC = EmailCC
    .BCC = EmailBCC
    .Subject = EmailSubject
    .Body = Replace("Geachte relatie,##In de bijlage ontvangt u, zoals besproken, het periodieke afname-overzicht.##*** Dit bericht is automatisch gegenereerd ***", "#", vbCr)
    .Attachments.Add EmailBestand
    .Send
End With
    Application.DisplayAlerts = True
End Sub

Ik gebruik deze werkmap:
Bekijk bijlage Takenlijst.xlsx

 

[HSV]

Test het maar eens.
Doe dit met '.Display' i.p.v. '.Send' om te testen.

Sub Email_Afname()
' Open benodigde excel bestand
    Workbooks.Open FileName:="G:\Takenlijst\Takenlijst.xlsx"
' Mail het bestand naar klant
    Application.DisplayAlerts = False
' Haal variabelen op
    KlantNr = Range("B3").Value
    EmailSubject = Range("G3").Value
    EmailAan = Range("H3").Value
    EmailContact = Range("I3").Value
    EmailCC = Range("J3").Value
    EmailBCC = Range("K3").Value
  
With CreateObject("Outlook.Application").CreateItem(olMailItem)
    .To = EmailAan
    .CC = EmailCC
    .BCC = EmailBCC
    .Subject = EmailSubject
    .Body = Replace("Geachte relatie,##In de bijlage ontvangt u, zoals besproken, het periodieke afname-overzicht.##*** Dit bericht is automatisch gegenereerd ***", "#", vbCr)

[COLOR=#FF0000]for i = 3 to cells(rows.count,12).end(xlup).row   
   .Attachments.Add  "K:\Afdelingen\Marketing\Afnameoverzichten\" & cells(i,12).value
next[/COLOR]
   
 .Send
End With
    Application.DisplayAlerts = True
End Sub

 

[alexander321]

Harry,

Dank voor je antwoord.
Met jouw aanpassing worden alle bestanden gemaild naar de mailadressen in rij3.
Ik heb het zelf een beetje verkeerd verwoord denk ik
Wat ik eigenlijk zou willen is dat er voor iedere klant een emailadres kan worden ingegeven, en dus moet hij steeds rij voor rij afgaan en daar de gegevens vandaan halen.

 

[HSV]

Zo beter Alexander?

Sub Email_Afname()
' Open benodigde excel bestand
    Workbooks.Open Filename:="G:\Takenlijst\Takenlijst.xlsx"
' Mail het bestand naar klant
    Application.DisplayAlerts = False
' Haal variabelen op
With CreateObject("Outlook.Application").CreateItem(olMailItem)
 For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    KlantNr = Cells(i, 2).Value
    EmailSubject = Cells(i, 7).Value
    EmailAan = Cells(i, 8).Value
    EmailContact = Cells(i, 9).Value
    EmailCC = Cells(i, 10).Value
    EmailBCC = Cells(i, 11).Value
    EmailBestand = "K:\Afdelingen\Marketing\Afnameoverzichten\" & Cells(i, 12).Value
    .To = EmailAan
    .CC = EmailCC
    .BCC = EmailBCC
    .Subject = EmailSubject
    .Body = Replace("Geachte relatie,##In de bijlage ontvangt u, zoals besproken, het periodieke afname-overzicht.##*** Dit bericht is automatisch gegenereerd ***", "#", vbCr)
    .Attachments.Add EmailBestand
    .Send
  Next i
End With
    Application.DisplayAlerts = True
End Sub

 

[alexander321]

Top!
Dank voor de snelle service Harry!

 

[HSV]

Graag gedaan.

 

[Nicu]

Is het dan ook mogelijk om te mailen zonder outlook te moeten gebruiken?

Groet,

Josh

 

[HSV]

Zoek in de Help van Vba naar "workbook.sendmail".
Die is jammer genoeg niet zo uitgebreid.

 

[alexander321]

Doorgaan als bestand niet aanwezig is

Onderstaande script werkt perfect, echter als een klant in een bepaalde maand geen afname heeft wordt het bestand (variabele: EmailBestand) niet gegenereerd, echter staat hij wel in de maandelijkse takenlijst.
Hoe laat ik checken of het bestand (variabele: EmailBestand) aanwezig is?
Als het bestand aanwezig is, moet hij mailen, indien niet aanwezig moet hij doorgaan met de volgende regel.
Nu stopt de verzending en volgt er een VBA foutmelding.
Wie helpt mij aan het stukje code? Alvast dank!

Sub Email_Afname()
' Open benodigde excel bestand
    Workbooks.Open Filename:="G:\Takenlijst\Takenlijst.xlsx"
' Mail het bestand naar klant
    Application.DisplayAlerts = False
' Haal variabelen op
With CreateObject("Outlook.Application").CreateItem(olMailItem)
 For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    KlantNr = Cells(i, 2).Value
    EmailSubject = Cells(i, 7).Value
    EmailAan = Cells(i, 8).Value
    EmailContact = Cells(i, 9).Value
    EmailCC = Cells(i, 10).Value
    EmailBCC = Cells(i, 11).Value
    EmailBestand = "K:\Afdelingen\Marketing\Afnameoverzichten\" & Cells(i, 12).Value
    .To = EmailAan
    .CC = EmailCC
    .BCC = EmailBCC
    .Subject = EmailSubject
    .Body = Replace("Geachte relatie,##In de bijlage ontvangt u, zoals besproken, het periodieke afname-overzicht.##*** Dit bericht is automatisch gegenereerd ***", "#", vbCr)
    .Attachments.Add EmailBestand
    .Send
  Next i
End With
    Application.DisplayAlerts = True
End Sub

 

[HSV]

De boel een beetje veranderd en aangepast.

Sub Email_Afname()
' Open benodigde excel bestand
    Workbooks.Open Filename:="G:\Takenlijst\Takenlijst.xlsx"
' Mail het bestand naar klant
    Application.DisplayAlerts = False
' Haal variabelen op
 For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
    KlantNr = Cells(i, 2).Value
    EmailSubject = Cells(i, 7).Value
    EmailAan = Cells(i, 8).Value
    EmailContact = Cells(i, 9).Value
    EmailCC = Cells(i, 10).Value
    EmailBCC = Cells(i, 11).Value
    EmailBestand = "K:\Afdelingen\Marketing\Afnameoverzichten\" & Cells(i, 12).Value
 
 If Not Dir(emailbestand, vbDirectory) = vbNullString Then
   With CreateObject("Outlook.Application").CreateItem(olMailItem)
   
      .To = EmailAan
      .CC = EmailCC
      .BCC = EmailBCC
      .Subject = EmailSubject
      .Body = Replace("Geachte relatie,##In de bijlage ontvangt u, zoals besproken, het periodieke afname-overzicht.##*** Dit bericht is automatisch gegenereerd ***", "#", vbCr)
      .Attachments.Add EmailBestand
      .Send
  End With
 
end if
Next i
    Application.DisplayAlerts = True
End Sub