i have vba script copies selected range of cells , pastes in body of email. within selected range of cells image of company logo. copies , pastes fine except image. there need image itself, maybe "embed" worksheet copies along cells? or there need in vba script copy image along cells?
here full code:
sub copyobjects() dim iscreated boolean dim pdffile string, title string, signature string dim outlapp object dim rngcopied range set rngcopied = selection ' use open outlook if possible on error resume next set outlapp = getobject(, "outlook.application") if err set outlapp = createobject("outlook.application") iscreated = true end if on error goto 0 ' prepare e-mail pdf attachment outlapp.createitem(0) .display ' need display email first signature added .subject = title .to = activesheet.range("e10").value ' <-- put email of recipient here or use cell value .cc = "whoever@abc.com; copy@abc.com" ' <-- put email of 'copy to' recipients here .htmlbody = "thank opportunity bid on painting " & activesheet.range("b9").value & ". " & " please read our attached proposal in it's entirety sure of inclusions, exclusions, , products proposed. give call questions or concerns." & _ vbnewline & vbnewline & _ rangetohtml(rngcopied) & _ "thank you," & _ .htmlbody ' adds default outlook account signature on error resume next ' return focus excel's window application.visible = true if err msgbox "e-mail not sent", vbexclamation else ' msgbox "e-mail sent", vbinformation end if on error goto 0 end ' try quit outlook if not open if iscreated outlapp.quit ' release memory of object variable ' note: outlook object can't released memory set outlapp = nothing end sub function rangetohtml(rng range) ' changed ron de bruin 28-oct-2006 ' working in office 2000-2010 dim fso object dim ts object dim tempfile string dim tempwb workbook tempfile = environ$("temp") & "/" & format(now, "dd-mm-yy h-mm-ss") & ".htm" 'copy range , create new workbook past data in rng.copy set tempwb = workbooks.add(1) tempwb.sheets(1) .cells(1).pastespecial paste:=8 .cells(1).pastespecial xlpastevalues, , false, false .cells(1).pastespecial xlpasteformats, , false, false .cells(1).select application.cutcopymode = false on error resume next .drawingobjects.visible = true .drawingobjects.delete on error goto 0 end 'publish sheet htm file tempwb.publishobjects.add( _ sourcetype:=xlsourcerange, _ filename:=tempfile, _ sheet:=tempwb.sheets(1).name, _ source:=tempwb.sheets(1).usedrange.address, _ htmltype:=xlhtmlstatic) .publish (true) end 'read data htm file rangetohtml set fso = createobject("scripting.filesystemobject") set ts = fso.getfile(tempfile).openastextstream(1, -2) rangetohtml = ts.readall ts.close rangetohtml = replace(rangetohtml, "align=center x:publishsource=", _ "align=left x:publishsource=") 'close tempwb tempwb.close savechanges:=false 'delete htm file used in function kill tempfile set ts = nothing set fso = nothing set tempwb = nothing end function
set
application.copyobjectswithcells = true before copying
Comments
Post a Comment