excel - VBA - Outlook Task Creation - Recipient based on Dynamic Range -
as of right now, below function works, need change recipient.add field corresponding email address, each change. of email address listed in column on worksheet, , ideally function automatically add correct email based on row.
i calling function using =addtotasks(a1,c1,d1) a1 date, c1, , text, , d1, amount of days prior a1, need reminder pop up. of outlook references correctly added, need figuring out email address.
excel , outlook 2010
option explicit dim bwestartedoutlook boolean function addtotasks(strdate string, strtext string, daysout integer) boolean dim intdaysback integer dim dtedate date dim olapp object ' outlook.application dim objtask object ' outlook.taskitem if (not isdate(strdate)) or (strtext = "") or (daysout <= 0) addtotasks = false goto exitproc end if intdaysback = daysout - (daysout * 2) dtedate = cdate(strdate) + intdaysback on error resume next set olapp = getoutlookapp on error goto 0 if not olapp nothing set objtask = olapp.createitem(3) ' task item objtask .startdate = dtedate .subject = strtext & ", audit start date: " & strdate .reminderset = true .recipients.add = "you@mail.com" .save .assign .send end else addtotasks = false goto exitproc end if addtotasks = true exitproc: if bwestartedoutlook olapp.quit end if set olapp = nothing set objtask = nothing end function function getoutlookapp() object on error resume next set getoutlookapp = getobject(, "outlook.application") if err.number <> 0 set getoutlookapp = createobject("outlook.application") bwestartedoutlook = true end if on error goto 0 end function
it seems need pass 1 more parameter function:
option explicit dim bwestartedoutlook boolean function addtotasks(strdate string, strtext string, daysout integer, email string) boolean dim intdaysback integer dim dtedate date dim olapp object ' outlook.application dim objtask object ' outlook.taskitem if (not isdate(strdate)) or (strtext = "") or (daysout <= 0) addtotasks = false goto exitproc end if intdaysback = daysout - (daysout * 2) dtedate = cdate(strdate) + intdaysback on error resume next set olapp = getoutlookapp on error goto 0 if not olapp nothing set objtask = olapp.createitem(3) ' task item objtask .startdate = dtedate .subject = strtext & ", audit start date: " & strdate .reminderset = true .recipients.add(email) .recipients.resolveall() .save .assign .send end else addtotasks = false goto exitproc end if addtotasks = true exitproc: if bwestartedoutlook olapp.quit end if set olapp = nothing set objtask = nothing end function function getoutlookapp() object on error resume next set getoutlookapp = getobject(, "outlook.application") if err.number <> 0 set getoutlookapp = createobject("outlook.application") bwestartedoutlook = true end if on error goto 0 end function
Comments
Post a Comment