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

 

[jbaich]

I don't know if it has anything to do with the fact that I'm at home now and accessing the network through a gateway, but my 'root folder'

[COLOR=#333333]strFolderPath = "\\'my folder path...'\"[/COLOR]

is not where the browsefolder function opens at... I'm not sure where or how this path is supposed to be implemented in the function...

[COLOR=#333333]Set oFolder = oShell.BrowseForFolder(0, "Please choose a folder", 0, OpenAt)[/COLOR]

Is the OpenAt command supposed somehow know to open at strFolderPath?
As it it basically opens to the c:\ location...

Thanks,
Joe

 

[jbaich]

so the debug.print OpenAt does actually contain the file path sent from strFolderPath... not sure why it's not opening the folder picker at this folder... must be because i'm accessing the network remotely (I hope)... I'll try it again from the office tomorrow and see if I get the same result!

Thanks,
Joe

 

[jbaich]

another thing I'm noticing is that when i use the picker to choose a location, it's not passing that string back to the main sub after the function is completed... so here I call the Pick sub, which calls the function and should be giving me my new string variable for strNewFolderPath so that I can create a new folder here, but when i hover over the strNewFolderPath variable there is nothing...

  Dim strFolderpath As String, strNewFolderPath As String    

Pick


MkDir (strNewFolderPath & "\" & FileRef)

 

[jbaich]

Here is my code as it stands at the moment for a complete picture if helpful...
I think everything is working as it should except for the folder picker not opening at the correct root folder location, but i'm hoping that's because I'm not on the network... I'll find out tomorrow!!!

Thanks again for all your help!

Public strSubject As String, strFolderpath As String, strNewFolderPath As String, FileRef As String, strInList As StringPublic olMail As Object
Option Explicit


Sub MsgChecker()


    '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
    Dim strInList As String, testSubject As String
    Dim answer As Integer


    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
    Debug.Print oMatchCollection.Count
    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
        Debug.Print strInList
        
        If strInList = "" Then
        MsgBox ("No references found, please ensure you have selected the correct message from your inbox")
        Exit Sub
        End If


answer = MsgBox("I have found the following " & oMatchCollection.Count & " references in this email: " & _
strInList & vbNewLine & "Select Ok to copy In List to clipboard and continue" & _
vbNewLine & "Select Cancel if these results are incorrect", vbOKCancel)
    
    If answer = vbOK Then
    Copy
        
    Else
    Exit Sub


End If
MsgBox ("To create folders for these files, you will need to know the primary actual use (ie: Res, Farm, ICI, Strata) for each. Click Ok when you have determined the correct uses to continue.")


    For Each oMatch In oMatchCollection
    FileRef = oMatch.SubMatches(1) & " - " & oMatch.SubMatches(2)
        SaveMessageAsMsg
    Next


MsgBox ("Completed")


Set oRegExp = Nothing


End Sub


Public Sub Copy()
    Dim zVar As Variant
    Dim zShell As Object
    zVar = strInList
    
    Set zShell = CreateObject("WScript.Shell")
    zShell.Run ("%comspec% /c echo " & zVar & " | clip"), vbHide


End Sub


Public Sub SaveMessageAsMsg()
  Dim oMail As Outlook.MailItem
  Dim objItem As Object
  Dim sPath As String
  Dim sName As String
  'Dim strFolderpath As String, strNewFolderPath As String
    


Pick


MkDir (strNewFolderPath & "\" & FileRef)


   For Each objItem In ActiveExplorer.Selection
   If objItem.MessageClass = "IPM.Note" Then
    Set oMail = objItem
    
  sName = oMail.Subject
  ReplaceCharsForFileName sName, "-"
  
  sPath = strNewFolderPath & "\" & FileRef & "\"
  Debug.Print sPath & sName
  oMail.SaveAs sPath & sName & ".msg", olMSG
   
  End If
  Next
   
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
  sChr As String _
)
  sName = Replace(sName, "'", sChr)
  sName = Replace(sName, "*", sChr)
  sName = Replace(sName, "/", sChr)
  sName = Replace(sName, "\", sChr)
  sName = Replace(sName, ":", sChr)
  sName = Replace(sName, "?", sChr)
  sName = Replace(sName, Chr(34), sChr)
  sName = Replace(sName, "<", sChr)
  sName = Replace(sName, ">", sChr)
  sName = Replace(sName, "|", sChr)
End Sub


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)
 Debug.Print OpenAt
 On Error Resume Next
    BrowseForFolder = ShellApp.Self.Path
 Debug.Print BrowseForFolder
 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


Sub Pick()
'Dim strFolderpath As String
'Dim strNewFolderPath As String
strFolderpath = "MyFolderPath\"
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

 

[Domenic]

First, you may or may not have noticed that I had made some changes to the BrowseForFolder function. There were a couple of reasons why I did so. As it stood, you couldn't differentiate between a user clicking on Cancel and an invalid selection. With my changes, you can test whether the user clicked on Cancel, made an invalid selection, or selected a valid folder, thereby taking the appropriate action. The other reason was that this bit...

CreateObject("Shell.Application"). _
         BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

...actual returns a Folder object, not an Application object. And so using ShellApp as the name used for the variable isn't logically correct. But since the function uses late binding, it's not detrimental to the results. I guess that's just me being a stickler for things. In any case, maybe there's some reason why you stuck with what you had. That's fine.

Secondly, in testing the BrowseForFolder function, I too find that it doesn't open the correct root folder. (On an aside, I'm not too crazy about the look of the dialog box ether.) Anyway, you can always use the FileDialog(msoFileDialogFilePicker) instead. From Outlook, you simply need to create an instance of Excel, and then use it to get access to the FileDialog object.

In any case, for your Pick procedure...

        Sub Pick(ByVal sInitialPath As String, ByRef sNewPath As Variant)
            sNewPath = BrowseForFolder(sInitialPath)
        End Sub

Then, in your SaveMessageAsMsg procedure...

          Dim strFolderpath As String
          Dim varNewFolderPath As Variant
          
          strFolderpath = "C:\Path\"

          Pick strFolderpath, varNewFolderPath

Now you can test the returned path in varNewFolderPath, etc.

 

[jbaich]

I did notice the changes, but didn't fully understand why... makes sense now. I had looked into the workaround of running an instance of Excel to use the msofilepicker as i'd found a thread on stackoverflow about this... the only thing was they recommended turning on the ms excel 14 library and I only have 12, not sure if that matters... also it did seem to take a little while to come up and this is going to be a program that is run A LOT so that could get a bit annoying... also, I was feeling super close to having the other version working... When i would initiate the Pick sub directly and F8 through it, it would call the browse function and open at the correct root location... the only problem i seemed to be having was passing the user's selected path back to the save messages sub to complete the save process... it seemed like the Browse function was not saving the user selection as a variable that was being passed back or something...?

I'm not going to be able to make it into the office this weekend to test on the network, but I've been trying out different root folder locations on my local hard drive and the paths display correctly for the variables in the immediate window, but the folder picker always opens up at the "my computer" level or at the bottom for lack of the right terminology...

I just don't get how it would work before when i initiated from the Pick sub and open at the picker at the correct level, but not if called from outside that sub...

also, should i be changing all of the strNewFolderPath variables in the savemessages sub to varNewFolderPath based on your revisions above? I'm assuming you're suggesting to just try changing that variable from string to variant?

I can see that the strFolderPath passes properly to the Pick sub and to the Browse function as when i hover over OpenAt before running the actual browse command line, it displays the strFodlerPath string... but even when using locations on my C drive, it always opens at the C:\ location... I guess maybe the Excel workaround might be the only option...

Thanks,
Joe

 

[Domenic]

I had looked into the workaround of running an instance of Excel to use the msofilepicker as i'd found a thread on stackoverflow about this... the only thing was they recommended turning on the ms excel 14 library and I only have 12, not sure if that matters...

Then you would set a reference Excel 12. Actually I would use late binding instead, so you wouldn't need to set a reference at all.

also it did seem to take a little while to come up and this is going to be a program that is run A LOT so that could get a bit annoying...

Interesting. I haven't compared the two.

also, should i be changing all of the strNewFolderPath variables in the savemessages sub to varNewFolderPath based on your revisions above? I'm assuming you're suggesting to just try changing that variable from string to variant?

Yeah, sorry about that. I guess that's what happens when working with stuff out of context.

...I guess maybe the Excel workaround might be the only option...

If you can't get it to work to your liking, then yeah, you can always go that route.

 

[Domenic]

I just don't get how it would work before when i initiated from the Pick sub and open at the picker at the correct level, but not if called from outside that sub...

Try declaring strFolderpath as Variant instead...

 

[jbaich]

ok, so I'm more or less back to where I was... I can get the picker to open up at the right spot, i can choose a file, but I don't know how to pass that BrowseForFolder string back to the Pick sub as a string or path...

So after the function is done and the code comes back to the Pick sub, i need to figure out how to reference the BrowseForFolder string without calling for the BrowseForFolder function... something like:

strNewFolderPath = BrowseForFolder

but this just seems to cause the function to run again...

when i debug.print BrowseForFolder in the function here...

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)
 Debug.Print OpenAt
 On Error Resume Next
    BrowseForFolder = ShellApp.Self.Path
[U][B] Debug.Print BrowseForFolder[/B][/U]
 On Error GoTo 0

I get the chosen path... can i do something like

strNewFolderPath = BrowseForFolder.Value

? That doesn't work, but something like it?

So, it turns out if i put strNewFolderPath = BrowseForFolder in the function...

 On Error Resume Next    BrowseForFolder = ShellApp.Self.Path
[U][B]strNewFolderPath = BrowseForFolder[/B][/U]
 On Error GoTo 0

and declare strNewFolderPath as Public, this will bring the new file path into the Pick sub... now i just need to see if I can apply this to the main and save sub and it should all work!!! fingers crossed...

 

[jbaich]

Ok, it almost all works except for now the sub Copy seems to be doing something weird... when i go to test it and CTRL + V I'm expecting to paste the text stored in the var strInList so in this case "In 2220500111111,2220500111112," This used to work... at least when I last tested it a few days ago... but now when I paste, I get "ECHO is on." What the heck does that mean? I also tried pasting some code between modules and no matter what I copy, when i try to paste it all i see is "ECHO is on."

It must have something to do with the fact that when i tested the Copy code originally i must have not used Option Explicit, because when after I added it into the main module, it gave me the not defined error on zShell... i guessed it was an object so I just declared it Dim zShell As Object.... Perhaps this was a mistake.... any idea how to fix it?

Thanks,
Joe