Check alle échte Black Friday-deals Ook zo moe van nepaanbiedingen? Wij laten alleen échte deals zien

VBA voor het triggeren van een persoonlijke e-mail in Excel

Pagina: 1
Acties:

  • EdgeStronaut
  • Registratie: Oktober 2013
  • Laatst online: 02-04 08:55
Dag allen,

Ik ben al een tijdje aan het zoeken naar, en knutselen aan, een VBA-script dat er voor zorgt dat, wanneer ik een checkbox in een Excel-sheet aanvinkt achter een regel met persoonsgegevens (naam, e-mail, telefoonnummer), een e-mail stuurt (via Outlook) naar die persoon met gepersonaliseerde begroeting.

Tot nu toe heb ik een simpel e-mail script dat ik gebruik om in één keer alle e-mails te genereren vanuit Excel in Outlook maar ik zou graag het proces graag willen personaliseren en efficiënter willen maken.

Andere suggesties voor het uitvoeren van zo'n proces zijn natuurlijk ook welkom.

P.S. Ik gebruik hiervoor Excel omdat er een database aan te pas komt die naar Excel wordt geëxporteerd.

Alvast bedankt,

  • F_J_K
  • Registratie: Juni 2001
  • Niet online

F_J_K

Moderator CSA/PB

Front verplichte underscores

Welkom op GoT!

IMHO wil je geen kant-en-klaar script zoeken, maar zelf maken met hooguit inspiratie uit andere code. Stap 1 voor meedenken zou zijn om de huidige code en de problemen daarbij te geven ;)
Een FOR-loopje om alle vinkjes af te gaan en de corresponderende regel uit te lezen combineren met de bestaande mail-code lijkt me al bijna genoeg. Waar loop je vast?
offtopic:
Ik zou het vereenvoudigen door geen vinkje te nemen maar "gewoon" een X in een bepaalde kolom. Maar dat is smaak.

'Multiple exclamation marks,' he went on, shaking his head, 'are a sure sign of a diseased mind' (Terry Pratchett, Eric)


  • Witte
  • Registratie: Februari 2000
  • Laatst online: 15-10 13:46
Dat hoeft toch niet met VBA?
Kan 'gewoon' met Word en Excel: https://support.office.co...4?ui=en-US&rs=en-ZA&ad=ZA en https://support.office.co...3?ui=en-US&rs=en-ZA&ad=ZA

[ Voor 27% gewijzigd door Witte op 26-02-2015 16:32 ]

Houdoe


  • EdgeStronaut
  • Registratie: Oktober 2013
  • Laatst online: 02-04 08:55
Dit is mijn huidige code:

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub SendMail(what_address As String, subject_line As String, mail_body As String)

    Dim olApp As Outlook.Application
    Set olApp = CreateObject("Outlook.Application")
    
    Dim olMail As Outlook.MailItem
    Set olMail = olApp.CreateItem(olMailItem)
    
olMail.To = what_address
    olMail.Subject = subject_line
    olMail.BodyFormat = olFormatHTML
    olMail.HTMLBody = mail_body
    olMail.Send

End Sub
-------------------------------------------------------------------------------------------------------------------------
Sub SendMassEmail()

row_number = 1

Do
DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    
    mail_body_message = Blad3.Range("A2")
    full_name = Blad2.Range("M" & row_number) & " " & Blad2.Range("O" & row_number) & " " & Blad2.Range("P" & row_number)
    
    mail_body_message = Replace(mail_body_message, "replace_name", full_name)

Call SendMail(Blad2.Range("Q" & row_number), "U heeft toegang tot de website van *** ", mail_body_message)
    
    
Loop Until row_number = 7

End Sub


Of deze

code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
Sub OutlookMail_1(what_address As String, subject_line As String, mail_body As String)

Dim applOL As Outlook.Application
Dim miOL As Outlook.MailItem
Dim recptOL As Outlook.Recipient
Dim ws As Worksheet

'set worksheet:
Set ws = ThisWorkbook.Sheets("Blad2")

'Create a new instance of the Outlook application. Set the Application object as follows:
Set applOL = New Outlook.Application

'create mail item:
Set miOL = applOL.CreateItem(olMailItem)

'Add mail recipients, either the email id or their name in your address book. Invalid ids will result in code error.
Set recptOL = miOL.Recipients.Add(what_address)
recptOL.Type = olTo
Set recptOL = miOL.Recipients.Add("***")
recptOL.Type = olBCC


'with the mail item:
With miOL

'subject of the mail:
.Subject = subject_line


'Chr(10) represents line feed/new line, & Chr(13) represents carriage return. Send text and also contents from the host workbook's worksheet range as Mail Body.
.HTMLBody = mail_body
 

'set importance level for the mail:
.Importance = olImportanceHigh
'add an attachment to the mail:
.Attachments.Add ("C:\...\Documents\Inkomenszekerheid.pdf")
'send the mail:

.Display

End With


'clear the object variables:
Set applOL = Nothing
Set miOL = Nothing
Set recptOL = Nothing


End Sub
---------------------------------------------------------------------------------------------------------------------------
Sub OutlookMail_2()

row_number = 1

Do
DoEvents
    row_number = row_number + 1
    Dim mail_body_message As String
    Dim full_name As String
    
    mail_body_message = Blad3.Range("A2")
    full_name = Blad2.Range("M" & row_number) & " " & Blad2.Range("O" & row_number) & " " & Blad2.Range("P" & row_number)
    
    mail_body_message = Replace(mail_body_message, "replace_name", full_name)

Call OutlookMail_1(Blad2.Range("Q" & row_number), "U heeft toegang tot de website van ***", mail_body_message)
    
    
Loop Until row_number = 7

End Sub


Het gaat mij nu om idd een For loopje die de persoonlijke regel ook meeneemt in het opstellen van die e-mail.

@Witte, ik heb dat geprobeerd maar vond het naar mijn mening niet prettig werken, ook i.v.m. de databases die worden gebruikt. Toch bedankt voor je suggestie.

Alvast bedankt,

[ Voor 0% gewijzigd door EdgeStronaut op 02-03-2015 10:28 . Reden: typo ]


  • Bozevkwa
  • Registratie: Augustus 2008
  • Laatst online: 22:10

Bozevkwa

The Falcons have landed

Ik heb recentelijk ook via excel zo'n 1100 emails uitgezonden. Allemaal persoonlijk met data uit Excel.

Mijn code:
Visual Basic:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Sub main()
  Dim iLp As Integer
  End 'to prevent sending out unwanted emails... Remove before use of sub
  iLp = 1
  While Len(Cells(iLp, 1).Value) > 0
    
    GenMail Cells(iLp, 2).Value
    Sleep 1000
    iLp = iLp + 1
  Wend
End Sub


Sub GenMail(Recipient As String)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    On Error Resume Next
    With OutMail
        .To = Recipient
        .CC = ""
        .BCC = ""
        .Subject = "Project notice"
        .BodyFormat = olFormatHTML
        .HTMLBody = "<!DOCTYPE html><HTML><BODY><span style='font-size:11.0pt;font-family:""Calibri"",""sans-serif"";color:#17365D'>Dear user,<br>" & _
         "<p>As part of our project activities, bla bla bla and a lot of more HTML codes and text</p></span>" & _
         "</BODY></HTML>"

        .ReadReceiptRequested = False
'        .Display  'Displays the email
        .Send 'Send its on its way to the recipient
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Hopelijk helpt dit je een stukje verder :)

"What day is it?" asked Pooh. "It's today" squeaked Piglet. "My favorite day" said Pooh.


  • Witte
  • Registratie: Februari 2000
  • Laatst online: 15-10 13:46
Denk wel aan een soort 'simulatie-modus' waarbij je het e-mailadres van de ontvanger vervangt door je eigen e-mailadres. Dit soort dingen wil je goed testen, voor er allerlei foute mails verzonden worden.
Denk ook aan een sleep-functie. Er zijn veel providers die bulk-mail niet leuk vinden.

Houdoe

Pagina: 1