InStr contains multiple matches 2

[smurfhell]

I have written an Outlook macro to help our project/email filing admin. It scans her inbox for all message subjects containing the text "BCE #" followed by a 4 or 5 digit number ie "New Project BCE #4311" and then saves them on the network under that job number. However, some people are sending messages the pertain to multiple job numbers so their subject would be "New set of jobs BCE #11034 BCE #7677".

Is there a way that I can have the macro save the message under each job number in the subject? Here's snippets of my current code.

Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    For Each item In Inbox.Items
        If InStr(1, item.Subject, "BCE #", 1) > 0 Then
        intPos = InStrRev(item.Subject, "BCE #", , vbTextCompare) + 5
        strtemp = Mid$(item.Subject, intPos, 5)
            If IsNumeric(strtemp) = True Then
            strlength = Len(strtemp)
            End If
                
            If strlength = 5 Then
            job2 = Left(strtemp, 2)
            sjob = "p:\" & Format(job2, "00") & "000s\" & strtemp
            semail = sjob & "\email"
            End If
   
            If strlength = 4 Then
            job1 = Left(strtemp, 1)
            sjob = "p:\" & Format(job1, "00") & "000s\" & strtemp
            semail = sjob & "\email"
            End If
            If DirExists(sjob) Then
                If DirExists(semail) Then
                    If FileThere(sjob & "\email\" & item.Subject & ".msg") Then
                    n = 0
                    Do
                        If FileThere(sjob & "\email\" & item.Subject & "-" & n & ".msg") Then
                        n = n + 1
                        Else
                        Exit Do
                        End If

Again, this is just a portion of my code and most importantly of all - I am not a programmer nor have I had any training whatsoever. If this is overly tedious or there is a much easier way, let me know.

Another thing - I can not just pull out any numbers from the subject because we also have some that reference facility numbers or zip codes like "Another project fac #4551 bce #8001".
Thanks.

 

[PHV]

A starting point:

...
For Each item In Inbox.Items
  If InStr(1, item.Subject, "BCE #", 1) > 0 Then
    For Each strTemp In Split(Subject, "BCE #")
      strTemp = Trim(strTemp)
      If IsNumeric(strTemp) And (Len(strTemp) = 4 Or Len(strTemp) = 5) Then
        job = Left(strTemp, Len(strTemp) - 3)
        sjob = "p:\" & Format(job, "00") & "000s\" & strtemp
        semail = sjob & "\email"
        If DirExists(sjob) Then
          If DirExists(semail) Then
            If FileThere(sjob & "\email\" & item.Subject & ".msg") Then
...
      End If 'IsNumeric(strTemp)
    Next 'strTemp
...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886

 

[Andrzejek]

Dim strBCENos() As String

strBCENos = Split(Item.Subject, "BCE #")

That will fill your array strBCENos where delimiter is "BCE #"

So, it you have Subject line: BCE #11034 BCE #7677, you will end up with:

strBCENos(0) = "11034"
strBCENos(1) = "7677"

You wil end up with as many elements of the array as you have BCE#s, isn't it nice?

It would be a good idea to Trim$ it to get rid of possible spaces.

HTH

---- Andy

 

[smurfhell]

Wow, thanks for both suggestions. I do have trim hidden somewhere in my actual macro, I just left it out when I pasted. (I also have a fancy feature in between that writes the subjects, job number, etc. to an html log file)

I'll see about implementing these and let you know if I run into any problems or have questions.