[RESOLVED] [outlook] Why are my For Each loops only working with the first item?

[stevedave]

Hi everyone,

I'm trying to remove any illeagle characters from a filename (i.e. :/\&#!? etc). I have a VBScript RegExp set up to execute and find the number of matches (Sub MainProgram2), then some For Each loops to cycle through and replace any such characters with a space. In a test, only the first such regexp match gets replaced properly, then it moves on. The locals pane (see picture) says my RegExp match collection variable "objMatches" has a Count of 1, and that Item 1 has a count of four SubMatches, and the test string has four illegal characters. Attachment 0. I'm not sure what a SubMatch is, but it doesn't seem to be what I need for the loop.

Does anyone have any suggestions? Thanks in advance, I am truly gratefull for the help.

[CODEPublic strSavePath As String
Public olApp As Outlook.Application
Public olExp As Outlook.Explorer
Public olSelect As Outlook.Selection
Public iNumber As Integer
Public oNS As Outlook.NameSpace
Public oFldr As Outlook.MAPIFolder
Public myEntryID As String
Public myFolderID As String
Public myDate As Date
Public mySubject As String
Public mySender As String
Public myItem As MailItem
'References:
' Microsoft VBScript regular expressions 5.5
' Microsoft ActiveX Data Objects 6.0
' Microsoft Shell Control and Automation (Shell32)
' Visual Basic For Applications
' Microsoft Outlook 11 Object Library
' Microsoft Forms 2.0 Object Library
'v1.75
'next version of project to include error handling

Public Sub MainProgram1()
GetSelection 'runs code to store mail selection to olSelect
InputForm.Show 'Shows the input form
End Sub

Public Sub MainProgram2()
Dim myString As String
Dim objCurrent As MailItem
Dim mFolderDI As MAPIFolder
Dim mlitmMoved As MailItem
Dim objMatches As MatchCollection
Dim Match As Match
Set objRegExp = New RegExp
With objRegExp
.Pattern = "(\W)|(\\)|(/)|(\.)"
.IgnoreCase = True
.Global = False
End With
iNumber = 0
cnt = olSelect.Count
Set mFolderDI = oNS.GetDefaultFolder(olFolderDeletedItems)
For i = cnt To 1 Step -1
iNumber = iNumber + 1 'used in StoreHeader
StoreHeader
myFolderID = oFldr.StoreID
myDateFormated = CStr(Format(myDate, "MM-DD-YY, hhmmss")) 'format date sent and convert Date data type to String
Set objMatches = objRegExp.Execute(mySubject)
For Each Match In objMatches 'DOES NOT GO THROUGH ALL MATCHES, JUST FIRST. BUT WHY?
mySubject = objRegExp.Replace(mySubject, " ")
Next
Set objMatches = objRegExp.Execute(mySender)
For Each Match In objMatches
mySender = objRegExp.Replace(mySender, " ")
Next
myString = myDateFormated & ", " & mySender & ", " & mySubject 'name outlook file will be renamed to, will need to handle errors incase name is too long
If Len(myString) > 240 Then 'make sure file name or path isn't too long
myString = Left(myString, 230)
End If
Set objCurrent = oNS.GetItemFromID(myEntryID, myFolderID)
myItem.SaveAs strSavePath & "\" & myString & ".msg", olMSG ' MAKES IT TO HERE THEN FAILS. myString shows that original subject string "08-09-12, 094939, Test: Email/ .does it work?" gets changed to "08-09-12, 094939, Test Email/ .does it work?". It should become "Test Email does it work
Set mlitmMoved = objCurrent.Move(mFolderDI)
mlitmMoved.Delete
Next
End Sub

Sub GetSelection()
'create an instance of Outlook object
Set olApp = CreateObject("Outlook.Application")
'define Explorer as the ActiveExplorer
Set olExp = olApp.ActiveExplorer
'get all of the emails that have been control+left clicked
Set olSelect = olExp.Selection
'get reference to inbox
Set oNS = olApp.GetNamespace("MAPI")
Set oFldr = oNS.GetDefaultFolder(olFolderInbox)

End Sub

Sub StoreHeader()
Set myItem = olSelect.Item(iNumber)
myEntryID = myItem.EntryID
myDate = myItem.SentOn
mySubject = myItem.Subject
mySender = myItem.SenderName
End Sub
][/CODE]

[His Nibbs]

I'm trying to remove any illeagle characters from a filename (i.e. :/\&#!? etc). ....... and replace any such characters with a space.

Do you need to use a regex? If not, try calling this function:

Function Validate_File_Name(ByVal fileName As String) As String

    Dim i As Integer, InvalidChars As String

    InvalidChars = ":/\&#!?"
    For i = 1 To Len(InvalidChars)
        fileName = Replace(fileName, Mid(InvalidChars, i, 1), " ")
    Next
    Validate_File_Name = fileName

End Function

[stevedave]

Thanks, Your Nibbs. I used that function and it worked great. I added the rest of the invalid characters too. I knew of the Replace function, but had missunderstood what it could do. I'm very gratefull for the help. I think the program is finally done.

I'm still curious about what went wrong with the code I wrote, but I need to give in to expediency so I can deploy this thing.