vba - List attachments in Outlook email under signature -
i experienced vba in excel new in outlook. know of script list attachments in outgoing email, under signature? triggered ribbon item or keyboard shortcut?
i send emails attachments , know sent looking @ email in conversation rather having find email attached items.
hopefully image clarify:
i generate last line of email. have script extract info when replying emails* don't know how attachment info out of email send.
* available here: http://www.slipstick.com/developer/code-samples/insert-attachment-names-replying/
this solution. on "send" detects desired attachment names , appends them after signature. if there existing list of attachments overwrites it.
i have used function encapsulate separate sections - "'check see if attachment info has been added" section optional. use in standard module replace second line sub() attachmentlister
'this sub inserts name of meaningful attachments after signature private sub application_itemsend(byval item object, cancel boolean) dim oatt attachment dim stratt, datemark, shorttime, finalmsg, attachname string dim olinspector, oinspector inspector dim oldocument object dim olselection object dim newmail mailitem dim attchcount, integer set oinspector = application.activeinspector set newmail = oinspector.currentitem newmail attchcount = .attachments.count if attchcount > 0 = 1 attchcount attachname = .attachments.item(i).displayname if instr(attachname, "pdf") <> 0 or instr(attachname, "xls") <> 0 or instr(attachname, "doc") <> 0 stratt = stratt & "<<" & attachname & ">> " & vbnewline end if next end if end goto skipsect ' section alternative method of getting attachment names each oatt in item.attachments if instr(oatt.filename, "xls") <> 0 or instr(oatt.filename, "doc") <> 0 or instr(oatt.filename, "pdf") <> 0 or instr(oatt.filename, "ppt") <> 0 or instr(oatt.filename, "msg") <> 0 or oatt.size > 95200 stratt = stratt & "<<" & oatt.filename & ">> " & vbnewline end if next set olinspector = application.activeinspector() set oldocument = olinspector.wordeditor set olselection = oldocument.application.selection skipsect: 'shorttime = format(time, "hh") & ":" & format(time, "nn") & " " datemark = " (dated " & date & shorttime & ")" if stratt = "" finalmsg = "" else finalmsg = "documents attached email" & datemark & ": " & vbnewline & stratt end if dim inputarea, searchterm string dim signatureline, endofemail integer 'find end of signature activeinspector.wordeditor.application .selection.wholestory .selection.find.clearformatting .selection.find .text = "sales co-ordinator" .replacement.text = "" .forward = true .wrap = wdfindask .format = false .matchcase = false end .selection.find.execute signatureline = .selection.range.information(wdfirstcharacterlinenumber) + 1 .selection.endkey unit:=wdline end 'check see if attachment info has been added activeinspector.wordeditor.application .selection.movedown unit:=wdline, count:=4, extend:=wdextend inputarea = .selection .selection.moveup unit:=wdline, count:=4, extend:=wdextend 'detect existing attachment lists if not instr(inputarea, "documents attached email") <> 0 .selection.typeparagraph .selection.typeparagraph else .selection.find .text = "from:" .replacement.text = "" .forward = true .wrap = wdfindask .format = false .matchcase = true .execute end 'in case email being replied not in english, 'try detect first line of next email looking mailto if .selection.find.found = false .selection.find .text = "mailto" .replacement.text = "" .forward = true .wrap = wdfindask .format = false .execute end end if 'designate last line of email , delete between , signature endofemail = .selection.range.information(wdfirstcharacterlinenumber) - 1 .selection.moveup unit:=wdline, count:=1, extend:=wdmove .selection.moveup unit:=wdline, count:=endofemail - signatureline, extend:=wdextend .selection.expand wdline .selection.delete end if end 'insert text , format it. activeinspector.wordeditor.application .selection.typeparagraph .selection.insertafter finalmsg 'insert message @ cursor. .selection.font.name = "calibri" .selection.font.size = 9 .selection.font.color = wdcolorblack end lastline: end sub
Comments
Post a Comment