string - Search outlook emails within a folder that contain start numbers/specific received date -

i looking have macro search through messages in folder , extract partially unique number in each email. example, have email contains number, 987654321 , email contains 987542132 both of these numbers have first 3 didgets in common, '987'. how can write in search trough , extract of numbers message, not entire message? if place in specific date ranges when messages recieved, nice too.

here current code have, when select folder in outlook, extract messages within folder , export spreadsheet w/ subject, received time , body. want specific numbers though!

sub exportmessagestoexcel()     dim olkmsg object, _         excapp object, _         excwkb object, _         excwks object, _         introw integer, _         intversion integer, _        strfilename string         strfilename = inputbox("enter filename , path save messages to.", "export messages excel")     if strfilename <> ""         intversion = getoutlookversion()         set excapp = createobject("excel.application")         set excwkb = excapp.workbooks.add()         set excwks = excwkb.activesheet         'write excel column headers         excwks             .cells(1, 1) = "subject"             .cells(1, 2) = "received"             .cells(1, 3) = "body"         end         introw = 2         'write messages spreadsheet         each olkmsg in application.activeexplorer.currentfolder.items             'only export messages, not receipts or appointment requests, etc.             if olkmsg.class = olmail                 'add row each field in message want export                 excwks.cells(introw, 1) = olkmsg.subject                 excwks.cells(introw, 2) = olkmsg.receivedtime                 excwks.cells(introw, 3) = findnum(olkmsg.body, "2014", 14)                    introw = introw + 1             end if         next         set olkmsg = nothing         excwkb.saveas strfilename         excwkb.close     end if     set excwks = nothing     set excwkb = nothing     set excapp = nothing     msgbox "completed.  total of " & introw - 2 & " messages exported.", vbinformation + vbokonly, "export messages excel" end sub  function getoutlookversion() integer     dim arrver variant     arrver = split(outlook.version, ".")     getoutlookversion = arrver(0) end function 

function findnum(bodytext string, lead string, numdigits integer) string dim counter long dim test string dim digits string counter = 1 numdigits - len(4) digits = digits & "10" next counter counter = 1 len(bodytext) - numdigits test = mid(bodytext, counter, numdigits) if test lead & digits findnum = test exit end if next counter end function

this find , return string of numeric characters of length specify lead specify longer string. think of instr uses wildcard return numeric value. had project once.

function findnum(bodytext string, lead string, numdigits integer) string dim counter long dim test string dim digits string counter = 1 numdigits - len(lead)     digits = digits & "#" next counter counter = 1 len(bodytext) - numdigits     test = mid(bodytext, counter, numdigits)     if test lead & digits         findnum = test         exit     end if next counter end function