excel vba - Outlook Email Macro -


i have mention code , works unique records, problem sends multiple emails 1 email id.

email id's n column w (1st record w6) , body of mail in column x6 have merge body code "wsht.cells(i, 25) = sbody"

any idea work wil send 1 email

for eg:- in w7 email id xxx@gmail.com , in w10 email id xxx@gmail.com code# send 2 mails, should send 1 email xxx@gmail.com

any idea or update.

private sub commandbutton3_click() dim outapp object dim outmail object  set outapp = createobject("outlook.application")  application   .enableevents = false   .screenupdating = false end  dim wsht worksheet dim lastrow long, lcuenta long dim integer, k integer dim sto string, ssbject string, sbody string  set wsht = activesheet lastrow = cells(rows.count, 1).end(xlup).row  = 6 lastrow   lcuenta = application.worksheetfunction.countif(range("w6:w" & i), range("w" & i))   if lcuenta = 1     ssubject = "pd call back"     sto = wsht.cells(i, 1)     sbody = wsht.cells(i, 24)     k = lastrow       if wsht.cells(i, 1).value = wsht.cells(k + 1, 1).value         sbody = sbody & vbnewline & wsht.cells(k + 1, 24).value       end if       wsht.cells(i, 25) = sbody     next k   end if    set outmail = outapp.createitem(0)    on error resume next   outmail     .to = sto     .subject = ssubject     .body = sbody     .send   end    next end sub 

your problem occurring because testing whether or not first time email id has been used and, if isn't, resending last email set up.

the end if test needs moved after section sends email:

private sub commandbutton3_click()     dim outapp object     dim outmail object      set outapp = createobject("outlook.application")      application         .enableevents = false         .screenupdating = false     end      dim wsht worksheet     dim lastrow long, lcuenta long     dim integer, k integer     dim sto string, ssbject string, sbody string      set wsht = activesheet     lastrow = cells(rows.count, 1).end(xlup).row      = 6 lastrow         lcuenta = application.worksheetfunction.countif(range("w6:w" & i), range("w" & i))          if lcuenta = 1             ssubject = "pd call back"             sto = wsht.cells(i, 1)             sbody = wsht.cells(i, 24)              k = lastrow                 if wsht.cells(i, 1).value = wsht.cells(k + 1, 1).value                     sbody = sbody & vbnewline & wsht.cells(k + 1, 24).value                 end if                 wsht.cells(i, 25) = sbody             next k          'end if  '<-- move              set outmail = outapp.createitem(0)              on error resume next             outmail                 .to = sto                 .subject = ssubject                 .body = sbody                 .send             end          end if '<-- here     next end sub 

Comments

Popular posts from this blog

sql server - Cannot query correctly (MSSQL - PHP - JSON) -

php - trouble displaying mysqli database results in correct order -

C++ Linked List -