How to use regexp and arrays to match groups or sets of 3 individual patterns?

[jbaich]

Sorry if this get's duplicated, tried to post, but wasn't logged in and then auto redirect didn't go anywhere, so went back and trying again...

Hey all, I'm new to Reg exp and I'm going to try to use it in Outlook... I know this is an Excel forum, but there are so many super smart and helpful people here I figured it might be worth asking.

I'm trying to match patterns, which occur in sets of 3. I have posted this question on another forum as well, where i was originally introduced to the Reg Exp function https://forums.slipstick.com/threads/95172-is-this-possible-to-do-with-a-macro/#post-347604, but with the holiday season, i'm not sure if I should be expecting a response in the short term and the usefulness of this macro (if I can get it to work) is increasing exponentially by the day, so I'd really love to figure something out in a hurry

So what I'm thinking is as follows, please correct me if I'm wrong:

example:
Pattern 1 = date
Pattern 2 = time
pattern 3 = postal code

The 3 individual patterns are SubMatches and together they would be a MatchCollection... right? Except instead of finding all the pattern 1 collections, all the pattern 2 collections and all the pattern 3 collections, I need to find all the pattern (1,2,3) collections... and store them for use later so i also need to create variables for them as they are identified... ie: collection 1, collection 2, collection 3... etc.

So I'm trying to figure out how to loop through and find all of the MatchCollections (1,2,3,) in my document... not sure how many there may be. I was thinking I could run a count of all the pattern 1 matches, which should give me the number of collections I'll need and then do an if loop for i = 1 to count... but I'm not sure how to group them... I've tried working with Case statements, but can only get as far as;

1. Having to create duplicate statements for each estimated recurrence (for example 3 match collections would require case 1-9 statements)... is there a way to just have the 3 case statements and then repeat the loop?

2. If I set Global=True, I will get all of the matches, grouped together as (1,1,1),(2,2,2),(3,3,3), however what I need to get is (1,2,3),(1,2,3),(1,2,3)

I'm guessing i need to incorporate arrays here somehow, but I've never really used arrays in VBA before and so far haven't been able to figure out what I need to do. Something like

[LIST]
[*]<article>[INDENT]Dim arr
 arr = Array("Collection 1","Collection 2","Collection 3")

[/INDENT]
</article>
[/LIST]

My code at this point is simply a patchwork of random failed attempts and commented out bits and pieces that may or may not be on the right track. As I said, new to both Reg and Arrays in VBA, so i think posting it might be more confusing than helpful, but if you think that would help, let me know and I will.

Any help would be very much appreciated! Also, i don't know the etiquette for cross posting, I know it's not the best and should be avoided to prevent duplication of effort, is this what Trackback is for? I'm guessing yes, so I've put the URL of the site I mentioned above in the trackback field here and hopefully that helps... I will also let Diane know over on Slipstick that I've asked this question here as well.

Thanks,
Joe

 

[Domenic]

For late binding, you don't have to set any references, and the code would be as follows...

Option Explicit

Sub test()

    'Outlook variables
    Dim olApp                       As Object
    Dim olMail                      As Object

    'VBScript variables
    Dim oRegExp                     As Object
    Dim oMatchCollection            As Object
    Dim oSubMatches                 As Object
    Dim oMatch                      As Object
    
    'Excel variables
    Dim oCol                        As New Collection
    Dim sPattern                    As String
    
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.ActiveExplorer.Selection.Item(1)
    
    sPattern = "Area[:]\s*\r\n(\d*)\s*\r\nJurisdiction[:]\s*\r\n(\d*)\s*\r\nRoll Number[:]\s*\r\n(\w*)"

    Set oRegExp = CreateObject("VBScript.RegExp")
    
    With oRegExp
        .Global = True
        .IgnoreCase = True
        .Pattern = sPattern
        Set oMatchCollection = .Execute(olMail.Body)
    End With
    
    For Each oMatch In oMatchCollection
        oCol.Add oMatch, oMatch.SubMatches(2)
    Next oMatch
    
    For Each oMatch In oCol
        Debug.Print oMatch.SubMatches(0), oMatch.SubMatches(1), oMatch.SubMatches(2)
    Next oMatch
    
End Sub

 

[jbaich]

Still getting an operation failed error message on the

Set oMatchCollection = .Execute(olMail.Body)

line... similar to previous but this time the run time error numbers are '-2147467259 (80004005)':

Would I maybe need to turn on an additional library or something? I have VBScript Regular Expressions 5.5 enabled... is there something else maybe?

Thanks,
Joe

 

[Comfy]

I think Outlook is blocking your Excel app.

When you run this do you get a popup in Outlook, "A program is trying to access e-mail address information"

With the Options to Allow or Deny.

 

[jbaich]

nope, i've never seen a popup like that before...

I've been googling trying to figure this out and there seem to be other posts out there of people having the same or similar errors, but in different contexts so i'm not sure exactly how applicable they are. Seems like some people are able to solve by checking if the object or variable is not "nothing" with an if statement preceding the Set statement... I don't know if this would change anything in this case as when i hover over the olMail object in the

Set olMail = olApp.ActiveExplorer.Selection.Item(1)

statement, I can see the email subject line value so I know it's referencing the message...

I'll keep googling, but I don't have a clue why this statement is throwing this error...

Thanks,
Joe

 

[Domenic]

From your last post, we see that there's no problem accessing objects from Outlook. So the problem must lie with VBScript. But you must have set a reference to the proper object library, otherwise you would have received the compile error "User-defined type not defined".

Try stepping through your code using the F8 key, and stop after the following line is executed...

Set oRegExp = CreateObject("VBScript.RegExp")

What do you get when you type the following line in the Immediate Window (Ctrl+G)...

? oRegExp is Nothing

Also, can you post the exact code that you're using?

 

[jbaich]

OMG.... I didn't know this was a thing, but it appears the name of the Sub was different from the name of the module (i had pasted the sub code into a module I'd been working in previously with a different name... when i changed the Sub name just now to match the module name it worked...!!!

Thank you so much!!!

So if want to have a variable called strInList that basically adds all the SubMatches together in a string preceded by the word "In " with a trailing space and separated by commas so that the value for this example would be
strInList = "In 2220500111111,2220500111112"

What would I be doing wrong with the following?

strInList = "In " & oMatch.SubMatches(0) & "," & oMatch.SubMatches(1) & "," & oMatch.SubMatches(2)

Thanks
Joe

 

[jbaich]

Ok, i figured out how to use the original example code I was working with to get the strInlist variable value I was after...

For Each oMatch In oCol        Debug.Print oMatch.SubMatches(0) & oMatch.SubMatches(1) & oMatch.SubMatches(2)
        strSubject = oMatch.SubMatches(0) & oMatch.SubMatches(1) & oMatch.SubMatches(2)
        strSubject = Replace(strSubject, Chr(13), "") & ","
        testSubject = testSubject & Trim(strSubject)
        Debug.Print testSubject
        strInList = "IN " & testSubject
    Next oMatch

How can I store the matches as variables or refer to their individual values later on in the macro? so for each loop through the above code, is there a way to create a variable for each match such as match(i) so that the first match is Match1, then next match becomes Match2, etc?

The next part of the macro will be creating folders for each match and saving a copy of the email in the newly created folder so something along the lines of

For Each oMatch In oCol ''' or maybe For i = 1 to oMatch.count (or something like that)''

I will call another sub that will (hopefully) use msoFileDialogFolderPicker to prompt the user to choose a save location, then create a folder and save a copy of the message... something like this...

Sub Save()

InitialFoldr$ = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select the correct folder for; " & strSubject & vbNewLine & _
 " A subfolder containing a copy of this email will be created there. "
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirectFldrRoot$ = .SelectedItems(1) & "\"
Else


End If
End With


FldrRoot = xDirectFldrRoot$
On Error Resume Next  '//if folder exists - igonore error and carry on\\


sPath = FldrRoot & strSubject & "\"
MkDir (sPath)  '//Create folder
oMail.SaveAs sPath & strSubject, olMSG




End Sub

I just need to figure out how to save the matches as variables strSubject1 through to i or how to save the values as a collection so that I can use for each match in the collection...

Thanks,
joe

 

[Domenic]

That's great. I'm glad you were able to correct the error.

Earlier I showed you how to refer to a match within the collection by referring to the roll number...

oCol("00111111").SubMatches(0)

You can also use an index number (ie. 1 for the first match, 2 for the second, and so on)...

    oCol(1).SubMatches(0)

And, you can also assign the match to an object variable, which has been declared as VBScript_RegExp_55.Match with early binding or Object with late binding...

    Set oMatch = oCol(1)
    oMatch.SubMatches(0)

Hope this helps!

 

[jbaich]

Thanks Domenic, you've been immensely helpful... I don't totally understand what you mean when you say

And, you can also assign the match to an object variable, which has been declared as VBScript_RegExp_55.Match with early binding or Object with late binding...

, but it may not be something i need to do at this point. I will read up on it and try to figure it out, but right now I'm just fighting with how to pick a folder and save... unfortunately it seems that Outlook does not support msoFileDialogFolderPicker...

I'm trying to figure out how I can call the BrowseForFolder function from my main macro AND call and pass a file path from

Sub Pick()Dim strFolderpath As String
strFolderpath = "\\'my folder path...'\"
BrowseForFolder (strFolderpath)
End Sub

to this function so that it initiates the folder selection from the appropriate root folder....

Function BrowseForFolder(Optional OpenAt As Variant) As Variant  Dim ShellApp As Object
  Set ShellApp = CreateObject("Shell.Application"). _
 BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
 
 On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
 On Error GoTo 0
 
 Set ShellApp = Nothing
    Select Case Mid(BrowseForFolder, 2, 1)
        Case Is = ":"
            If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
 Exit Function
 
Invalid:
 BrowseForFolder = False
End Function

I'm sure it's super simple, I feel like it should be

Function BrowseForFolder([B]IN HERE[/B]) As Variant

, but so far I'm stumpped...

so main macro calls the savemessages sub, which calls the browseforfolder function which needs the root folder path string passed to it somehow...

So close i can taste it....

 

[Domenic]

If you need to access the FileDialog object from within Outlook, you can create an instance of Excel, and then use it to access the object. But since you've already gone in a different direction, try...

Sub Pick()
    Dim strFolderPath As String
    Dim strNewFolderPath As String
    strFolderPath = "\\'my folder path...'\"
    strNewFolderPath = BrowseForFolder(strFolderPath)
    If Len(strNewFolderPath) = 0 Then
        MsgBox "User cancelled...", vbInformation 'optional
    ElseIf strNewFolderPath = "False" Then
        MsgBox "Invalid selection...", vbInformation
    Else
        MsgBox strNewFolderPath & "\", vbInformation
    End If
End Sub


Function BrowseForFolder(Optional OpenAt As String) As String

    Dim oShell As Object
    Dim oFolder As Object
    Dim sFolderName As String
    
    Set oShell = CreateObject("Shell.Application")
    Set oFolder = oShell.BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
    
    If oFolder Is Nothing Then Exit Function
    
    sFolderName = oFolder.Self.Path
    
    Select Case Mid(sFolderName, 2, 1)
        Case Is = ":"
            If Left(sFolderName, 1) = ":" Then GoTo Invalid
        Case Is = "\"
            If Not Left(sFolderName, 1) = "\" Then GoTo Invalid
        Case Else
            GoTo Invalid
    End Select
    
    BrowseForFolder = sFolderName
    
    Exit Function
 
Invalid:
    BrowseForFolder = False
 
End Function