i'm new , i'm creating mail merge.
i've taken code other websites , pieced together.
the code works fine, sends email using data in data sheet, can't format email.
most of need default outlook signature each user - or else option include default user's signature in excel field, formatting again problem in cells.
the data sheet button select range , send email:
the email sheet options edit each line: 
#if vba7 , win64 private declare ptrsafe function shellexecute lib "shell32.dll" alias "shellexecutea" ( _ byval hwnd longptr, byval lpoperation string, _ byval lpfile string, byval lpparameters string, byval lpdirectory string, _ byval nshowcmd long) longptr #else private declare function shellexecute lib "shell32.dll" alias "shellexecutea" ( _ byval hwnd long, byval lpoperation string, _ byval lpfile string, byval lpparameters string, byval lpdirectory string, _ byval nshowcmd long) long #end if sub sendemail() dim xemail string dim xsubj string dim xmsg string dim xurl string dim integer dim k double dim xcell range dim xrg range dim xtxt string on error resume next xtxt = activewindow.rangeselection.address set xrg = application.inputbox("please select data range:", "watercorp mailmerge", xtxt, , , , , 8) if xrg nothing exit sub if xrg.columns.count <> 4 msgbox " please make sure have selected data (4 columns)", , "watercorp mailmerge" exit sub end if = 1 xrg.rows.count ' email address xemail = xrg.cells(i, 2) ' message subject xsubj = "" & sheet2.cells(2, 2) & " " & xrg.cells(i, 3) & " - " & _ xrg.cells(i, 4) & "" ' compose message xmsg = "" xmsg = xmsg & "" & sheet2.cells(4, 2) & " " & xrg.cells(i, 1) & "," & vbcrlf & vbcrlf xmsg = xmsg & "" & sheet2.cells(6, 2) & " " & sheet2.cells(6, 4) & " " & sheet2.cells(6, 6) & " " & vbcrlf & vbcrlf xmsg = xmsg & "" & sheet2.cells(8, 2) & " " & vbcrlf & vbcrlf xmsg = xmsg & "" & sheet2.cells(10, 2) & "" & vbnewline & signature '.send ' replace spaces %20 (hex) xsubj = application.worksheetfunction.substitute(xsubj, " ", "%20") xmsg = application.worksheetfunction.substitute(xmsg, " ", "%20") ' replace carriage returns %0d%0a (hex) xmsg = application.worksheetfunction.substitute(xmsg, vbcrlf, "%0d%0a") ' create url xurl = "mailto:" & xemail & "?subject=" & xsubj & "&body=" & xmsg ' execute url (start email client) shellexecute 0&, vbnullstring, xurl, vbnullstring, vbnullstring, vbnormalfocus ' wait 2 seconds before sending keystrokes application.wait (now + timevalue("0:00:02")) application.sendkeys "%s" next end sub from research i've seen may need send email html?
Comments
Post a Comment