Regex help

[jgtg32a]

I figured out how to do the folder creation but I'm having trouble with the regex part of the script

I get a 5018 error when I run it with the pattern I actually need to run and a type missmatch when I run it with an easy match


Option Explicit
Sub main()
Call SortToEmailFolders
End Sub

Sub SortToEmailFolders(Optional ByVal copyOnly As Boolean = True) 'changed default
'---------------------------------------------------------------------------
' Procedure : SortToEmailFolders
' Author : Aaron Bush
' Date : 05/08/2008
' Purpose : Sorts all email in inbox into a folder named by the sender.
' Input(s) : copyOnly(default) - If true, rather than moving email to
' folders, a copy of the email will be sent to the
' folder while leaving the original in the inbox.
'---------------------------------------------------------------------------
Const strMailItem_c As String = "MailItem"
Dim ns As Outlook.NameSpace
Dim mfMain As Outlook.MAPIFolder
Dim mfInbox As Outlook.MAPIFolder
Dim mfDstn As Outlook.MAPIFolder
Dim miCurnt As Outlook.MailItem
Dim objItem As Object
On Error GoTo Err_Hnd
Set ns = Outlook.Session
Set mfInbox = ns.GetDefaultFolder(olFolderInbox)
Set mfMain = mfInbox.parent

Dim folder As String 'will be the results of the search
Dim pattern As String 'will be the regex
'pattern = "^*\(([a-z]*)\)" 'the regex looks for the value between ( )
'pattern = a
Dim Subject As String 'the value between ( ) is a location which will be folder name
For Each objItem In mfInbox.Items 'goes through the mailbox

If TypeName(objItem) = strMailItem_c Then
Set miCurnt = objItem
Subject = miCurnt.SenderName

folder = RegExpTest(pattern, Subject)
If Not FolderExists(mfMain, folder) Then
Set mfDstn = mfMain.Folders.Add(folder)
Else
Set mfDstn = mfMain.Folders(folder)
End If
If copyOnly Then
miCurnt.Copy.Move mfDstn
Else
miCurnt.Move mfDstn
End If
End If
Next

Exit_Proc:
On Error Resume Next
Set objItem = Nothing
Set miCurnt = Nothing
Set mfInbox = Nothing
Set mfMain = Nothing
Set ns = Nothing
Exit Sub
Err_Hnd:
MsgBox Err.Description, vbSystemModal, "Error: " & Err.Number
Resume Exit_Proc
End Sub

Private Function FolderExists(ByRef parent As Outlook.MAPIFolder, ByVal name As String) As Boolean
On Error Resume Next
Dim mfTest As Outlook.MAPIFolder
Set mfTest = parent.Folders(name)
FolderExists = Not CBool(Err.Number)
End Function
Private Function RegExpTest(ByVal sP As String, ByVal sS As String) As String
'takes 2 values 1 the RE, and the string
Dim strToSearch As String
strToSearch = sS
Dim strPattern As String
strPattern = sP
Dim re As RegExp 'regex object
Dim oMatch As Match 'the value that is found and returned
'MsgBox (strToSearch)
'MsgBox (strPattern)

Set re = New RegExp 'make new obj
re.Global = True
re.IgnoreCase = True
re.pattern = strPattern 'set the pattern
Set oMatch = re.Execute(strToSearch) 'run pattern on sring and save to value

End Function

[matthewspatrick]

Some things I noticed:

It looks like you have your RegExp set up to return an array of matches, not just the first match
I cannot see where you actually set a return value for RegExpTest

You may want to have a look at the RegExpFind function defined here:
http://vbaexpress.com/kb/getarticle.php?kb_id=760

[jgtg32a]

There will only be one match per entry so I changed it to a string
I added the return value I thought that BASIC would return the last seen value, I looked on line and it said that it would return the value that is stored in a variable that has the same name as the sub
I haven't uses a BASIC language in nearly 10 years.

Now its giving me an error about the Regex that I pass to it "application defined error"

I look through the KB but none of the example there did what I wanted them to do, I need it to return $1, from perl.