hoe moet ik de code aanpassen, is onder deel van de grootte code
Code:
If TELLER > 0 Then Next i Else
If MsgBox("er is een voorbeeld naar uw e-mailadres verstuurd, is deze goed?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("mogen er " & Range("AANTAL_MAILS") & " e-mails verzonden worden?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("weet U zeker dat de " & Range("AANTAL_MAILS") & " e-mails mogen worden verzonden?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("dit is uw laatste kans om op nee te drukken", vbYesNo) = vbNo Then Exit Sub
Next i
Code:
Sub mails_versturen()
Sheets("E_mail").Activate
Range("BEGINCEL") = " "
Sheets("E_mailadres").Visible = False
Sheets("Rekenen").Visible = False
Sheets("REEDS VERZONDEN").Visible = False
Range("TELLER") = 0
x = Range("AANTAL_MAILS").Value
a = Range("E_MAILONDERWERP").Value
Range("BEGINCEL") = " "
BESTANDSNAAM = Range("BESTANDSNAAM").Value
Windows(BESTANDSNAAM).Activate
'Application.ScreenUpdating = True
'Application.ScreenUpdating = False
BEWAAR_XLSM_OUD = Range("BEWAAR_XLSM").Value
BEWAARNAAM_XLSM = Range("BEWAARNAAM_XLSM").Value
OPENNAAM = Range("OPENNAAM").Value
Workbooks.Open Filename:=OPENNAAM
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=BEWAARNAAM_XLSM
Application.DisplayAlerts = True
Application.ActivateMicrosoftApp xlMicrosoftMail
Application.Wait DateAdd("s", 5, Now)
For i = 0 To x
wacht = Application.WorksheetFunction.RandBetween(5, 10) * 0.000001 '5 = 0,5sec ; 10 = 1,0sec
Application.Wait (Now + wacht)
Windows(BESTANDSNAAM).Activate
BEWAARNAAM_XLSM_OUD = Range("BEWAARNAAM_XLSM").Value
TELLER = i
Range("TELLER") = i
BEWAAR_XLSM = Range("BEWAAR_XLSM").Value
BEWAARNAAM_XLSM = Range("BEWAARNAAM_XLSM").Value
BEWAARNAAM_PDF = Range("BEWAARNAAM_PDF").Value
E_MAILADRES = Range("E_MAILADRES").Value
CC_E_MAILADRES = Range("E_MAILADRES_CC").Value
NAAM = Range("NAAM").Value
ACHTERNAAM = Range("ACHTERNAAM").Value
ADRES = Range("ADRES").Value
POSTCODE = Range("POSTCODE").Value
INZENDERSCODE = Range("INZENDERSCODE").Value
PLAATS = Range("PLAATS").Value
TELEFOON = Range("TELEFOON").Value
GEBOORTEDATUM = Range("GEBOORTEDATUM").Value
KLN_NUMMER = Range("KLN_NUMMER").Value
NBS_NUMMER = Range("NBS_NUMMER").Value
VIVFN_NUMMER = Range("VIVFN_NUMMER").Value
VERENIGING = Range("VERENIGING").Value
SPECIAALCLUB = Range("SPECIAALCLUB").Value
Windows(BEWAAR_XLSM_OUD).Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=BEWAARNAAM_XLSM
Application.DisplayAlerts = True
If TELLER > 1 Then Kill BEWAARNAAM_XLSM_OUD
Windows(BEWAAR_XLSM).Activate
Range("E_MAILADRES") = E_MAILADRES
Range("ACHTERNAAM") = ACHTERNAAM
Range("ADRES") = ADRES
Range("POSTCODE") = POSTCODE
Range("INZENDERSCODE") = INZENDERSCODE
Range("PLAATS") = PLAATS
Range("TELEFOON") = TELEFOON
Range("GEBOORTEDATUM") = GEBOORTEDATUM
Range("KLN_NUMMER") = KLN_NUMMER
Range("NBS_NUMMER") = NBS_NUMMER
Range("VIVFN_NUMMER") = VIVFN_NUMMER
Range("VERENIGING") = VERENIGING
Range("SPECIAALCLUB") = SPECIAALCLUB
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=BEWAARNAAM_XLSM
Application.DisplayAlerts = True
Range("PRINTGEDEELTE").ExportAsFixedFormat Type:=xlTypePDF, Filename:=BEWAARNAAM_PDF
Windows(BESTANDSNAAM).Activate
BEWAAR_XLSM_OUD = Range("BEWAAR_XLSM").Value
BIJLAGE_1 = Range("BIJLAGE_1").Value
BIJLAGE_2 = Range("BIJLAGE_2").Value
BIJLAGE_3 = Range("BIJLAGE_3").Value
BIJLAGE_4 = Range("BIJLAGE_4").Value
BIJLAGE_5 = Range("BIJLAGE_5").Value
BIJLAGE_6 = Range("BIJLAGE_6").Value
BIJLAGE_7 = Range("BIJLAGE_7").Value
BIJLAGE_8 = Range("BIJLAGE_8").Value
BIJLAGE_9 = Range("BIJLAGE_9").Value
BIJLAGE_10 = Range("BIJLAGE_10").Value
E_MAILADRES = Range("E_MAILADRES").Value
E_MAILONDERWERP = TELLER & "." & Range("AANTAL_MAILS").Value & "." & a
tekst = Range("E_MAILTEKST")
For j = 1 To UBound(tekst)
E_MAILTEKST = E_MAILTEKST & "<tr><td>" & Join(Application.Index(tekst, j), "</td><td>") & "</td></tr>"
Next
E_MAILTEKST = E_MAILTEKST & "</table><P></P><P></P>"
With CreateObject("Outlook.Application").CreateItem(0)
.To = E_MAILADRES
.CC = CC_E_MAILADRES
.Subject = E_MAILONDERWERP
.HTMLBody = E_MAILTEKST
If BIJLAGE_1 <> "" Then .attachments.Add BIJLAGE_1
If BIJLAGE_2 <> "" Then .attachments.Add BIJLAGE_2
If BIJLAGE_3 <> "" Then .attachments.Add BIJLAGE_3
If BIJLAGE_4 <> "" Then .attachments.Add BIJLAGE_4
If BIJLAGE_5 <> "" Then .attachments.Add BIJLAGE_5
If BIJLAGE_6 <> "" Then .attachments.Add BIJLAGE_6
If BIJLAGE_7 <> "" Then .attachments.Add BIJLAGE_7
If BIJLAGE_8 <> "" Then .attachments.Add BIJLAGE_8
If BIJLAGE_9 <> "" Then .attachments.Add BIJLAGE_9
If BIJLAGE_10 <> "" Then .attachments.Add BIJLAGE_10
.Send
E_MAILTEKST = ""
End With
If LCase(Left(BEWAAR_XLSM, 4)) = "mail" Then Kill BEWAARNAAM_PDF
If TELLER > 0 Then Next i Else
If MsgBox("er is een voorbeeld naar uw e-mailadres verstuurd, is deze goed?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("mogen er " & Range("AANTAL_MAILS") & " e-mails verzonden worden?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("weet U zeker dat de " & Range("AANTAL_MAILS") & " e-mails mogen worden verzonden?", vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
If MsgBox("dit is uw laatste kans om op nee te drukken", vbYesNo) = vbNo Then Exit Sub
Next i
Windows(BEWAAR_XLSM).Activate
ActiveWindow.Close
Kill BEWAARNAAM_XLSM
Sheets("E_mailadres").Visible = True
Sheets("Rekenen").Visible = True
Sheets("REEDS VERZONDEN").Visible = True
'If LCase(Left(BEWAAR_XLSM, 4)) = "mail" Then Kill BEWAARNAAM_PDF
Application.ScreenUpdating = True
End Sub
